Разделение таблицы по листам
В Microsoft Excel есть много инструментов для сборки данных из нескольких таблиц (с разных листов или из разных файлов): прямые ссылки, функция ДВССЫЛ (INDIRECT), надстройки Power Query и Power Pivot и т.д. С этой стороны баррикад всё выглядит неплохо.
Но если вы нарвётесь на обратную задачу - разнесения данных из одной таблицы на разные листы - то всё будет гораздо печальнее. На сегодняшний момент цивилизованных встроенных инструментов для такого разделения данных в арсенале Excel, к сожалению, нет. Так что придется задействовать макрос на Visual Basic, либо воспольоваться связкой макрорекордер+Power Query с небольшой "доработкой напильником" после.
Давайте подробно рассмотрим, как это можно реализовать.
Постановка задачи
Имеем в качестве исходных данных вот такую таблицу размером больше 5000 строк по продажам:
Задача: разнести данные из этой таблицы по городам на отдельные листы этой книги. Т.е. на выходе нужно получить на каждом листе только те строки из таблицы, где продажа была в соответствующем городе:
Подготовка
Чтобы не усложнять код макроса и сделать его максимально простым для понимания, выполним пару подготовительных действий.
Во-первых, создадим отдельную таблицу-справочник, где в единственном столбце будут перечислены все города, для которых нужно создать отдельные листы. Само-собой, в этом справочнике могут быть не все города, присутствующие в исходных данных, а только те, по которым нам нужны отчеты. Проще всего создать такую таблицу, используя команду Данные - Удалить дубликаты (Data - Remove duplicates) для копии столбца Город или функцию УНИК (UNIQUE) - если у вас последняя версия Excel 365.
Поскольку новые листы в Excel по умолчанию создаются перед (левее) текущего (предыдущего), то имеет смысл также отсортировать города в этом справочнике по убыванию (от Я до А) - тогда после создания листы-города расположатся по алфавиту.
Во-вторых, преобразуем обе таблицы в динамические ("умные"), чтобы с ними было проще работать. Используем команду Главная - Форматировать как таблицу (Home - Format as Table) или сочетание клавиш Ctrl+T. На появившейся вкладке Конструктор (Design) назовём их таблПродажи и таблГорода, соответственно:
Способ 1. Макрос для деления по листам
На вкладке Разработчик (Developer) нажмите на кнопку Visual Basic или используйте сочетание клавиш Alt+F11. В открывшемся окне редактора макросов вставьте новый пустой модуль через меню Insert - Module и скопируйте туда следующий код:
Sub Splitter()
For Each cell In Range("таблГорода")
Range("таблПродажи").AutoFilter Field:=3, Criteria1:=cell.Value
Range("таблПродажи[#All]").SpecialCells(xlCellTypeVisible).Copy
Sheets.Add
ActiveSheet.Paste
ActiveSheet.Name = cell.Value
ActiveSheet.UsedRange.Columns.AutoFit
Next cell
Worksheets("Данные").ShowAllData
End Sub
Здесь с помощью цикла For Each ... Next реализован проход по ячейкам справочника таблГорода, где для каждого города происходит его фильтрация (метод AutoFilter) в исходной таблице продаж и затем копирование результатов на новый созданный лист. Попутно созданный лист переименовывается в то же имя города и на нем включается автоподбор ширины столбцов для красоты.
Запустить созданный макрос в Excel можно на вкладке Разработчик кнопкой Макросы (Developer - Macros) или сочетанием клавиш Alt+F8.
Способ 2. Создаем множественные запросы в Power Query
У предыдущего способа, при всей его компактности и простоте, есть существенный недостаток - созданные макросом листы не обновляются при изменениях в исходной таблице продаж. Если обновление "на лету" необходимо, то придется использовать связку VBA+Power Query, а точнее - создавать с помощью макроса не просто листы со статическими данными, а обновляемые запросы Power Query.
Макрос в этом случае частично похож на предыдущий (в нём тоже есть цикл For Each ... Next для перебора городов в справочнике), но внутри цикла будет уже не фильтрация и копирование, а создание запроса Power Query и выгрузка его результатов на новый лист:
Sub Splitter2()
For Each cell In Range("таблГорода")
ActiveWorkbook.Queries.Add Name:=cell.Value, Formula:= _
"let" & Chr(13) & "" & Chr(10) & " Источник = Excel.CurrentWorkbook(){[Name=""таблПродажи""]}[Content]," & Chr(13) & "" & Chr(10) & " #""Измененный тип"" = Table.TransformColumnTypes(Источник,{{""Категория"", type text}, {""Наименование"", type text}, {""Город"", type text}, {""Менеджер"", type text}, {""Дата сделки"", type datetime}, {""Стоимость"", type number}})," & Chr(13) & "" & Chr(10) & " #""Строки с примененным фильтром"" = Table.Se" & _
"lectRows(#""Измененный тип"", each ([Город] = """ & cell.Value & """))" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " #""Строки с примененным фильтром"""
ActiveWorkbook.Worksheets.Add
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=" & cell.Value & ";Extended Properties=""""" _
, Destination:=Range("$A$1")).QueryTable
.CommandType = xlCmdSql
.CommandText = Array("SELECT * FROM [" & cell.Value & "]")
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = cell.Value
.Refresh BackgroundQuery:=False
End With
ActiveSheet.Name = cell.Value
Next cell
End Sub
После его запуска мы увидим те же листы по городам, но формировать их будут уже созданные запросы Power Query:
При любых изменениях в исходных данных достаточно будет обновить соответствующую таблицу правой кнопкой мыши - команда Обновить (Refresh) или обновить сразу все города оптом, используя кнопку Обновить всё на вкладке Данные (Data - Refresh All).
Ссылки по теме
- Что такое макросы, как их создавать и использовать
- Сохранение листов книги как отдельных файлов
- Сборка данных со всех листов книги в одну таблицу
"Runtime Error 1004, это имя уже используется, выберите другое"
Все листы появились, но в них остались только заголовки.
Хорошо было бы в надстройку что-то подобное, но более гибкое)
Вот в LibreOffice Calc, к сожалению, действительно нет.
Помогите пожалуйста макрос запинается на .ListObject.DisplayName = cell.Value
Макрос прописан один в один как у Николая, кроме где PQ выбираем фильтр.
Спасибо большое!
"Runtime Error 1004, это имя уже используется, выберите другое", после нажатие продолжить снова - ошибку показывает на строке:
.ListObject.DisplayName = cell.Value
Если ошибку игнорировать и посмотреть в запросы Power Query - там запрос есть, но - сформированной таблицы нет. Возможно ограничения в строчках самой таблице (у меня более 20000 строк и в "справочнике" всего 8 позиций на разделение по листам)?!? Сам макрос идентичен Вашему.
А в нашей стране есть города Санкт-Петербург, Нижний Новгород и пр. ввиду этого имеет смысл не использовать эту строку
Очень плохо еще разбираюсь в макросах, подскажите, пожалуйста, как адаптировать вариант 1 так, чтобы копировалась также ширина столбцов и из диапазонов создавались умные таблицы, все равно с каким именем?
Спасибо!
В итоге совместила свои запросы с еще одной задачей, описанной у вас - на перенос получившихся листов в разные книги и сохранение, и получился вот такой макрос:
Sub Splitter()
For Each cell In Range("Auditors")
Range("byVisitsSKU").AutoFilter Field:=1, Criteria1:=cell.Value
Range("byVisitsSKU[#All]").SpecialCells(xlCellTypeVisible).Copy
Sheets.Add
ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.AutoFilter
ActiveSheet.Name = cell.Value
ActiveSheet.UsedRange.Rows.AutoFit
Next cell
Worksheets("by Visits_SKU").ShowAllData
Dim s As Worksheet
Dim wb As Workbook
Set wb = ActiveWorkbook
For Each s In wb.Worksheets
s.Copy
ActiveWorkbook.SaveAs "C:\Users\User\Desktop\Nestle Waters\Íîâàÿ ïàïêà" & "\" & s.Name & "_01-09.05.xlsx"
ActiveWorkbook.Close
Next
End Sub
Помогите адаптировать Ваш макрос под свой файл:facepalm:
Не совсем работает.
Страницы создаёт, а потом ошибка: ActiveSheet.Name = cell.Value имя уже есть
Файл не создает
Что может быть такое в макросах новичок))
Спасибо за облегчение труда и автору и участникам!
Скажите пожалуйста, как быть если критериев отбора не 1, а 2 или 3? К примеру и по городам и по датам.
Помогите пожалуйста очень очень нужно.
Спасибо!
Спасибо большое за представленные варианты!
Воспользовалась 1 способом - получилось разделить, но все данные скопировались на новые листы как значения, а мне нужно оставить формулы, которые были на исходном листе.
Подскажите, пожалуйста, как это можно сделать?
Object doesn't support this property or method (Error 438). Что не так?
1. как подправить макрос Способа 2(Создаем множественные запросы в Power Query) что бы разбивал таблицу на листы в отдельных файлах? и будут ли таблицы обновляться?
2, попроще думаю ))
как в
ActiveWorkbook.Queries.Add Name:=cell.Value, Formula:= _
"let" & Chr(13) & & Chr(10) & " .............{{""Категория"", type text}, {""Наименование"", type text}, {""Город"", type text},
когда много столбцов переносить на другую строку , {""........."", type text} когда их много
пробовал пробел+_ ентер
ошибку выдает
1. как подправить макрос Способа 2(Создаем множественные запросы в Power Query) что бы разбивал таблицу на листы в отдельных файлах? и будут ли таблицы обновляться?
2, попроще думаю ))
как в
ActiveWorkbook.Queries.Add Name:=cell.Value, Formula:= _
"let" & Chr(13) & & Chr(10) & " .............{{""Категория"", type text}, {""Наименование"", type text}, {""Город"", type text},
когда много столбцов переносить на другую строку , {""........."", type text} когда их много
пробовал пробел+_ ентер
ошибку выдает
Range("Табл1[#All]").SpecialCells(xlCellTypeVisible).CopyЧто означает Табл1[#All ?
вариант 2 выдает ошибку: ошибка 438 object doesn't support this property or method
Подскажите как исправить?