Автоматическое деление таблицы по листам в excel

Разделение таблицы по листам

В 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).

Ссылки по теме

• Что такое макросы, как их создавать и использовать
• Сохранение листов книги как отдельных файлов
• Сборка данных со всех листов книги в одну таблицу

Именно так называется очередное видео от Николая Павлова, размещенное на его сайте https://www.planetaexcel.ru. Полная ссылка https://www.planetaexcel.ru/techniques/12/18012/

https://www.planetaexcel.ru/techniques/12/18012/

Здесь имеется прекрасный разбор примера продаж по разным городам.

Основная суть. Есть таблица с некоторым ключевым полем.  Через меню Умная таблица даем ей имя ТаблПродажи.

Копируем столбец с ключевым полем правее основной таблицы. Задаем ей имя  через тот же пункт меню ТаблГорода.

Оставляем в этом столбце лишь уникальные записи. В 2016 Excel это делается также через меню.

Создаем макрос Splitter. Код его представлен. При запуске макроса происходит разноска данных одного листа за счет применения фильтрации и выборки на новые листы, которым присваивается имя обрабатываемого города.

Применённая технология может быть использована на различных данных, где на листе имеются совпадающие ключевые значения в одном или нескольких столбцах. Обычно их называют критерии. Это могут быть Criteria1, Criteria2 и т.д.  Т.е. ключевых полей может быть и несколько как и столбцов основной таблицы, где мы и будем искать эти критерии(ключи) на совпадение.

В образовании такими ключами чаще всего выступают номер класса и его литера. Часто эти значения разделены по разным столбцам. Я предпочитал всегда разносить класс и его литеру по разным столбцам.

Во всяком случае я давно использовал этот метод разноски данных с одного листа по разным классам или школам.

Я до сих пор предпочитаю по старинке работать в Excel 2003. Возможности его ограничены по сравнению со старшими версиями. От этого даже становится интересно проверить 2003 версию на примерах 2016 версии. 2016 версия у меня стоит на другом ПК., который использует внучка.

Есть более универсальный метод выборки данных с применением механизма создания диапазона строка RowRange.

Обычно лист с данными для последующей выборки имеет несколько строк шапки сверху. А данные начинаются со строки 4, 5 или 6.

Поэтому вначале мы создаем диапазон, содержащий шапку, а затем к нему через оператор

Set RowRange = Union(RowRange, ActiveSheet.Rows(i)) добавляем найденные строки с нужными нам критериями.

Макрос формирует новый лист с выбранными по ключу данными и возвращает количество найденных записей Sum1.

Программа версия Excel 2003 по реализации предложенного метода Н.Павловым, но с учетом невозможности реализации функций 2016 версии.

Данные представляют из себя сведения об учениках одной из школ с убранными идентифицирующими сведениями: Фамилия, адрес, телефон. Шапка расположена в строках 1-5. Данные располагаются со строки 6. Запуск через auto_open с формой из трех команд.

На самом деле важность представляет лишь последняя команда и связанный с ней вызываемый модуль. Две предыдущие команды просто показывают последовательность реализации выборки учащихся по классам, – удаление всех листов кроме листа Данные, переход к столбцу критерии и собственно самой выборки.

Показ изменения данных на листах книги блокирован до завершения программы, как и вывод системных сообщений. Обработка листов показывается в строке статуса.

Программа Школа_Классы.xls

Введение

Предположим, у нас есть рабочий лист с большим количеством данных, и нам нужно разделить данные на отдельные книги Excel на основе столбца «Категория». Решить данную проблему возможно ручным способом, применяя инструмент фильтрации данных. Однако повторное копирование данных потребует терпения.

Как быстро разделить таблицу Excel на отдельные книги макросом. Пошаговый алгоритм

• Сочетанием клавиш Alt+F11 открываем окно Visual Basic
• Создаем новый модуль Insert -> Module
• Вставляем код

Sub Разделить_столбец_по_книгам()
Const column = 2 'номер столбца, по которому будет происходить разделение.'
Const head = True
Set wbAct = ActiveWorkbook

Set dic = CreateObject("Scripting.Dictionary")

lr = Cells(Rows.Count, 1).End(xlUp).Row
lc = Cells(1, Columns.Count).End(xlToLeft).column

arr = Range("A1", Cells(lr, lc)).Value

If head Then fr = 2 Else fr = 1

For i = fr To UBound(arr)
    If Trim(arr(i, column)) <> "" Then dic.Item(arr(i, column)) = dic.Item(arr(i, column)) & "|" & i
Next

iPath = wbAct.Path & Application.PathSeparator & "Result" & Application.PathSeparator
'Result - название папки с результатами'
If Dir(iPath, vbDirectory) = "" Then MkDir iPath

arrDic = dic.keys
Set Rng = Nothing
Application.DisplayAlerts = False
For i = 0 To UBound(arrDic)
rrs = Split(Mid(dic.Item(arrDic(i)), 2), "|")
    If head Then Set Rng = Rows(1)
    For Each rr In rrs
        If Not Rng Is Nothing Then Set Rng = Union(Rows(rr), Rng) Else Set Rng = Rows(rr)
    Next
    Set wb = Workbooks.Add(1)
    Set sh = wb.Sheets(1)
    Rng.Copy
    sh.[A1].PasteSpecial xlPasteColumnWidths
    sh.[A1].PasteSpecial xlPasteAll
    Set Rng = Nothing
    wb.SaveAs iPath & Replace_symbols(arrDic(i)) & ".xlsx", xlOpenXMLWorkbook
    wb.Close False
Next
Application.DisplayAlerts = True
End Sub
'Замена запрещённых символов в имени файла или папки'
Function Replace_symbols(ByVal txt As String) As String
    St$ = "\/~!@#$%^&*=|`'"""
    For i% = 1 To Len(St$)
        txt = Replace(txt, Mid(St$, i, 1), "_")
    Next
    Replace_symbols = txt
End Function

• На второй строке кода, цифру 2 замените на номер столбца, в котором содержится критерий для разбиения
• Сохраните код Ctrl+S
• Сохраните файл Excel, как книгу с поддержкой макросов xlsm
• Выполните макрос Alt+F8

Папка с новыми файлами будет лежать по тому же пути, что и файл, в котором вы запускали макрос

Заключение

С помощью этого руководства и готового кода макроса Вы сможете сэкономить свое время и за несколько минут создать столько книг Excel, сколько уникальных значений в выбранном Вами столбце. Вся остальная информация автоматически перенесется в новые книги.

У нас Вы можете заказать выполнение задач по MS Excel и Google таблицам

А также, пройти бесплатные онлайн курсы по MS Excel с заданиями

Предположим, у вас есть рабочий лист с огромными строками данных, и теперь вам нужно разбить данные на несколько рабочих листов на основе Имя и фамилия столбец (см. следующий снимок экрана), а имена вводятся случайным образом. Может быть, вы можете сначала отсортировать их, а затем скопировать и вставить их один за другим в другие новые рабочие листы. Но для повторного копирования и вставки потребуется ваше терпение. Сегодня я расскажу о некоторых быстрых приемах решения этой задачи.

Разделить данные на несколько листов на основе столбца с кодом VBA

Разделить данные на несколько рабочих листов на основе столбца с Kutools for Excel

Разделить данные на несколько листов на основе столбца с кодом VBA

Если вы хотите быстро и автоматически разделить данные на основе значения столбца, следующий код VBA — хороший выбор. Пожалуйста, сделайте так:

1. Удерживайте ALT + F11 , чтобы открыть Microsoft Visual Basic для приложений окно.

2. Нажмите Вставить > Модулии вставьте следующий код в окно модуля.

Sub Splitdatabycol()
'updateby Extendoffice
Dim lr As Long
Dim ws As Worksheet
Dim vcol, i As Integer
Dim icol As Long
Dim myarr As Variant
Dim title As String
Dim titlerow As Integer
Dim xTRg As Range
Dim xVRg As Range
Dim xWSTRg As Worksheet
Dim xWS As Worksheet
On Error Resume Next
Set xTRg = Application.InputBox("Please select the header rows:", "Kutools for Excel", "", Type:=8)
If TypeName(xTRg) = "Nothing" Then Exit Sub
Set xVRg = Application.InputBox("Please select the column you want to split data based on:", "Kutools for Excel", "", Type:=8)
If TypeName(xVRg) = "Nothing" Then Exit Sub
vcol = xVRg.Column
Set ws = xTRg.Worksheet
lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
title = xTRg.AddressLocal
titlerow = xTRg.Cells(1).Row
icol = ws.Columns.Count
ws.Cells(1, icol) = "Unique"
Application.DisplayAlerts = False
If Not Evaluate("=ISREF('xTRgWs_Sheet!A1')") Then
Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = "xTRgWs_Sheet"
Else
Sheets("xTRgWs_Sheet").Delete
Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = "xTRgWs_Sheet"
End If
Set xWSTRg = Sheets("xTRgWs_Sheet")
xTRg.Copy
xWSTRg.Paste Destination:=xWSTRg.Range("A1")
ws.Activate
For i = (titlerow + xTRg.Rows.Count) To lr
On Error Resume Next
If ws.Cells(i, vcol) <> "" And Application.WorksheetFunction.Match(ws.Cells(i, vcol), ws.Columns(icol), 0) = 0 Then
ws.Cells(ws.Rows.Count, icol).End(xlUp).Offset(1) = ws.Cells(i, vcol)
End If
Next
myarr = Application.WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants))
ws.Columns(icol).Clear
For i = 2 To UBound(myarr)
ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(i) & ""
If Not Evaluate("=ISREF('" & myarr(i) & "'!A1)") Then
Set xWS = Sheets.Add(after:=Worksheets(Worksheets.Count))
xWS.Name = myarr(i) & ""
Else
xWS.Move after:=Worksheets(Worksheets.Count)
End If
xWSTRg.Range(title).Copy
xWS.Paste Destination:=xWS.Range("A1")
ws.Range("A" & (titlerow + xTRg.Rows.Count) & ":A" & lr).EntireRow.Copy xWS.Range("A" & (titlerow + xTRg.Rows.Count))
Sheets(myarr(i) & "").Columns.AutoFit
Next
xWSTRg.Delete
ws.AutoFilterMode = False
ws.Activate
Application.DisplayAlerts = True
End Sub

3, Затем нажмите F5 нажмите клавишу для запуска кода, и появится окно подсказки, напоминающее вам о выборе строки заголовка, см. снимок экрана:

4. А затем нажмите OK и во втором поле запроса выберите данные столбца, которые вы хотите разделить на основе, см. снимок экрана:

5, Затем нажмите OK, и все данные на активном листе разбиваются на несколько листов по значению столбца. И разделенные листы названы с именами разделенных ячеек. Смотрите скриншот:

Внимание: Разделенные листы помещаются в конец книги, где находится главный рабочий лист.

Разделить данные на несколько рабочих листов на основе столбца с Kutools for Excel

Примечание:Чтобы применить это Разделить данные, во-первых, вы должны скачать Kutools for Excel, а затем быстро и легко примените эту функцию.

После установки Kutools for Excel, пожалуйста, сделайте так:

1. Выберите диапазон данных, которые вы хотите разделить.

2. Нажмите Кутулс Плюс > Рабочий лист > Разделить данные, см. снимок экрана:

3. В Разделить данные на несколько листов диалоговое окно, вам необходимо:

1). Выбрать Конкретный столбец вариант в Сплит на основе раздел и выберите значение столбца, по которому вы хотите разделить данные, в раскрывающемся списке. (Если у ваших данных есть заголовки, и вы хотите вставить их в каждый новый разделенный лист, проверьте У моих данных есть заголовки опция).

2). Затем вы можете указать имена разделенных листов под Имя нового листа раздел, укажите правила имен рабочих листов из Правила раскрывающийся список, вы можете добавить Префикс or Суффикс также для имен листов.

3). Щелкните значок OK кнопка. Смотрите скриншот:

4. Теперь данные разделены на несколько листов в новой книге.

Нажмите, чтобы скачать Kutools for Excel и бесплатная пробная версия прямо сейчас!

Разделить данные на несколько рабочих листов на основе столбца с Kutools for Excel

Kutools for Excel включает более 300 удобных инструментов Excel. Бесплатная пробная версия без ограничений в течение 30 дней. Загрузите бесплатную пробную версию прямо сейчас!

Связанная статья:

Как разбить данные на несколько листов по количеству строк?