Разделение таблицы по листам
В 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 способом - получилось разделить, но все данные скопировались на новые листы как значения, а мне нужно оставить формулы, которые были на исходном листе.
Подскажите, пожалуйста, как это можно сделать?