Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Разделение одного листа на несколько по условию в строке - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Разделение одного листа на несколько по условию в строке (Макросы/Sub)
Разделение одного листа на несколько по условию в строке
Leojse Дата: Четверг, 07.05.2020, 21:36 | Сообщение № 1
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 131
Репутация: 0 ±
Замечаний: 0% ±

2010/2013
Добрый вечер.
Прошу помочь в решении следующей задачи.
Есть лист и в нем несколько однотипных таблиц (лист "Исходный формат"). Количество столбцов не меняется, но в таблицах может быть разное количество строк. Необходимо этот лист разбить на несколько листов. Каждый лист должен начинаться с пустой строки + "Сведения о клиенте". Имя листа должно присваиваться из строки, которая идет после "Сведения о клиенте". Причем, слова "по списку" не должны быть в имени листа.
Есть похожие темы на форумах, но во всех примерах есть отдельный столбец, в котором содержатся признаки, по которому нужно делить лист. А столбца с признаком у меня нет. Нашел макрос (в книге в примере), который делает похожие операции, но не могу разобраться в коде, чтобы подредактировать под свои нужды.
Буду рад любому совету/подсказке!
К сообщению приложен файл: 6397870.xls(54.5 Kb)
 
Ответить
СообщениеДобрый вечер.
Прошу помочь в решении следующей задачи.
Есть лист и в нем несколько однотипных таблиц (лист "Исходный формат"). Количество столбцов не меняется, но в таблицах может быть разное количество строк. Необходимо этот лист разбить на несколько листов. Каждый лист должен начинаться с пустой строки + "Сведения о клиенте". Имя листа должно присваиваться из строки, которая идет после "Сведения о клиенте". Причем, слова "по списку" не должны быть в имени листа.
Есть похожие темы на форумах, но во всех примерах есть отдельный столбец, в котором содержатся признаки, по которому нужно делить лист. А столбца с признаком у меня нет. Нашел макрос (в книге в примере), который делает похожие операции, но не могу разобраться в коде, чтобы подредактировать под свои нужды.
Буду рад любому совету/подсказке!

Автор - Leojse
Дата добавления - 07.05.2020 в 21:36
Kuzmich Дата: Четверг, 07.05.2020, 22:54 | Сообщение № 2
Группа: Проверенные
Ранг: Обитатель
Сообщений: 485
Репутация: 98 ±
Замечаний: 0% ±

Excel 2003
Оставьте только лист Исходный формат и запустите макрос
[vba]
Код
Sub DivideTable1()
Dim FoundCell As Range
Dim FAdr As String
Dim FRow As Long
Dim ERow As Long
Dim NameList As String
Dim List1 As Worksheet
  Set List1 = ThisWorkbook.Worksheets("Исходный формат")
  Set FoundCell = Columns("B:AA").Find("Сведения о клиенте", , xlValues, xlWhole)
   If Not FoundCell Is Nothing Then
     FAdr = FoundCell.Address
     Do
       FRow = FoundCell.Row
       ERow = Cells(FRow + 6, "V").End(xlDown).Row
        NameList = Split(FoundCell.Offset(1), " ")(2)
        Worksheets.Add After:=Worksheets(Worksheets.Count)     'созданный лист будет активным
        ActiveSheet.Name = NameList
        List1.Range(List1.Cells(FRow, "A"), List1.Cells(ERow, "AD")).Copy
          Range("A2").PasteSpecial xlPasteColumnWidths
          Range("A2").PasteSpecial xlPasteAll
          Range("A1").Select
        List1.Select
        Set FoundCell = Columns("B:AA").FindNext(FoundCell)
     Loop While FoundCell.Address <> FAdr
   End If
   Application.CutCopyMode = False
End Sub
[/vba]
 
Ответить
СообщениеОставьте только лист Исходный формат и запустите макрос
[vba]
Код
Sub DivideTable1()
Dim FoundCell As Range
Dim FAdr As String
Dim FRow As Long
Dim ERow As Long
Dim NameList As String
Dim List1 As Worksheet
  Set List1 = ThisWorkbook.Worksheets("Исходный формат")
  Set FoundCell = Columns("B:AA").Find("Сведения о клиенте", , xlValues, xlWhole)
   If Not FoundCell Is Nothing Then
     FAdr = FoundCell.Address
     Do
       FRow = FoundCell.Row
       ERow = Cells(FRow + 6, "V").End(xlDown).Row
        NameList = Split(FoundCell.Offset(1), " ")(2)
        Worksheets.Add After:=Worksheets(Worksheets.Count)     'созданный лист будет активным
        ActiveSheet.Name = NameList
        List1.Range(List1.Cells(FRow, "A"), List1.Cells(ERow, "AD")).Copy
          Range("A2").PasteSpecial xlPasteColumnWidths
          Range("A2").PasteSpecial xlPasteAll
          Range("A1").Select
        List1.Select
        Set FoundCell = Columns("B:AA").FindNext(FoundCell)
     Loop While FoundCell.Address <> FAdr
   End If
   Application.CutCopyMode = False
End Sub
[/vba]

Автор - Kuzmich
Дата добавления - 07.05.2020 в 22:54
Leojse Дата: Четверг, 07.05.2020, 23:22 | Сообщение № 3
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 131
Репутация: 0 ±
Замечаний: 0% ±

2010/2013
Kuzmich, даже не знаю, как Вас благодарить!
Огромное Вам спасибо!!!
 
Ответить
СообщениеKuzmich, даже не знаю, как Вас благодарить!
Огромное Вам спасибо!!!

Автор - Leojse
Дата добавления - 07.05.2020 в 23:22
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Разделение одного листа на несколько по условию в строке (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс цитирования
© 2010-2020 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!