Что делает макрос: Одной из наиболее распространенных задач, с которыми сталкивается пользователь Excel, разделение набора данных на отдельные листы. Например, если у вас есть набор данных,
который содержит строки для востока, запада, юга и севера регионов, вам может быть предложено создать новый лист для данных Востока, новый лист для данных Запада, новый лист для Юга и один для Севера. Если вам нужно делать это постоянно, то вы можете использовать этот макрос, чтобы он делал тяжелую работу за вас.
Как макрос работает
Макроса сам по себе прост. Начнем с набором данных, который содержит автофильтр. Мы указываем макросу на поле, которое используется для разделения данных на отдельные листы. В этом случае нам нужно создать отдельный лист для каждого региона. Поле Регион является первым полем в наборе отфильтрованных данных.
Макрос проходит через это поле, захватив элементы данных в этой области (север, юг, восток, запад). Затем он использует каждый элемент данных в качестве критерия фильтрации Автофильтра.
Каждый раз, когда область фильтруется, макрос копирует отфильтрованный диапазон и вставляет данные в новый лист. После того, как данные вставляются, он называет лист тем же именем, что и критерий фильтра.
Код макроса
Sub NoviiListDlyaElementovAvtofiltra()
'Шаг 1: Объявляем переменные
Dim MySheet As Worksheet
Dim MyRange As Range
Dim UList As Collection
Dim UListValue As Variant
Dim i As Long
'Шаг 2: Установите лист, который содержит автофильтр
Set MySheet = ActiveSheet
'Шаг 3: Если лист не фильтруется автоматически, выйдите
If MySheet.AutoFilterMode = False Then
Exit Sub
End If
'Шаг 4: Укажите столбец, содержащий данные, которые вы хотите 'фильтровать
Set MyRange = Range(MySheet.AutoFilter.Range.Columns(1).Address)
'Шаг 5: Создание новой коллекции объектов
Set UList = New Collection
'Шаг 6: Заполнение коллекции объектов уникальными значениями
On Error Resume Next
For i = 2 To MyRange.Rows.Count
UList.Add MyRange.Cells(i, 1), CStr(MyRange.Cells(i, 1))
Next i
On Error GoTo 0
'Шаг 7: Запуск цикла по коллекции значений
For Each UListValue In UList
'Шаг 8: Удалить все листы, которые могли быть ранее созданы
On Error Resume Next
Application.DisplayAlerts = False
Sheets(CStr(UListValue)).Delete
Application.DisplayAlerts = True
On Error GoTo 0
'Шаг 9: Фильтруйте автофильтр, чтобы соответствовать текущему значению
MyRange.AutoFilter Field:=1, Criteria1:=UListValue
'Шаг 10: Скопируйте отфильтрованный диапазон на новый лист
MySheet.AutoFilter.Range.Copy
Worksheets.Add.Paste
ActiveSheet.Name = Left(UListValue, 30)
Cells.EntireColumn.AutoFit
'Шаг 11: Просмотрите следующие значения
Next UListValue
'Шаг 12: Вернуться на главную страницу и удалить фильтр
MySheet.AutoFilter.ShowAllData
MySheet.Select
End Sub
Как это код работает
- Шаг 1 запускает макрос, объявив пять переменных. MySheet является переменной рабочего листа, которая используется для идентификации листа, в котором хранятся данные AutoFiltered. MyRange является переменной диапазона, который содержит диапазон нашего основного поля фильтра (поле Регион в данном сценарии). UList является объектом Collection, который помогает нам извлечь уникальные элементы из нашего основного поля фильтра. UListValue переменная служит, как простой счетчик для нашей переменной MyRange.
- Шаг 2 устанавливает переменную MySheet, чтобы держать лист, в котором AutoFilter находится. Важно, сделать это, потому что мы должны возвращаться к этому листу на протяжении макроса. Здесь макрос будет срабатывать из листа, который содержит автофильтр, поэтому мы используем ActiveSheet.
Вы также можете изменить макрос и явно указать имя листа вместо ActiveSheet, установив MySheet = Sheets(«YourSheetName»). - Шаг 3 проверяет свойство AutoFilterMode, чтобы увидеть применяются ли автофильтры. Если нет, то он выходит из процедуры.
- Если макрос достигает Шаг 4, мы определили, что действительно автофильтр применяется в MySheet.
Теперь нам нужно захватить номер столбца, который содержит элементы, которые будут использоваться для анализа наших данных, установленные на отдельные листы. В нашем примере эта область — первый столбец. Таким образом, мы устанавливаем поле MyRange в Columns(1) диапазона Автофильтр. Это важно! Мы используем указанный столбец, чтобы создать уникальный список элементов, с нашими данными.
При реализации этого макроса в вашей работе, вам необходимо изменить номер столбца. - Шаг 5 инициализирует объект UList Collection. Объект Collection представляет собой контейнер, который может содержать массив уникальных элементов данных. На самом деле, объект Collection может содержать только уникальные данные. Если вы пытаетесь заполнить его неоднородными данными, он выдает сообщение об ошибке. Мы используем объект коллекции,
чтобы провести уникальный список элементов из нашей переменной MyRange. В этом случае, MyRange указывает на столбец, объект Collection на уникальный список регионов (Восток, Север, Юг, Запад). - Шаг 6 заполняет объект UList коллекции с уникальными элементами данных в MyRange.
Для этого он использует переменную I цикл по строкам столбца MyRange. Вы заметите, что мы начинаем I на 2; это потому, что строка 1 содержит метку заголовка. Мы не хотим включать метку заголовка в качестве одного из уникальных элементов в нашем объекте коллекции.
На каждом цикле, макрос пытается добавить текущую ячейку в коллекции UList. Синтаксис для добавления элемента в коллекции, CollectionName.Add ItemName, UniqueKeyIdentifier
В этом случае мы добавляем каждую ячейку в MyRange и как имя элемента и уникального ключа. Поскольку коллекция UList выдает ошибку, если элементы данных не являются уникальными, мы проверяем весь раздел в On Error Resume Next и On Error Goto 0. Это гарантирует, что, если будут добавлены дублирующие элементы, коллекция UList игнорирует их. В конце цикла, у нас есть уникальный список всех элементов данных в MyRange. Опять же, в этом случае, это означает, что у нас есть уникальный список регионов (Восток, Север, Юг, Запад). - Шаг 7 работает исключительно с коллекцией UList. Эта коллекция содержит уникальный список элементов, который мы используем в качестве критериев фильтра и имена листов для наших вновь созданных листов. Макрос начинает цикл по списку с переменной UListValue.
- Каждый раз, когда мы запускаем этот макрос, новый лист будет добавлен для каждого уникального элемента в нашей области целевого фильтра, с именами листов. Если запустить этот макрос более чем один раз, то может возникнуть ошибка, потому что мы будем создавать лист, который уже существует. Чтобы этого не произошло, Шаг 8 удаляет любой лист, имя которого совпадает с элементом данных UListValue.
- Шаг 9 использует UListValue для фильтрации автофильтра, динамически передавая UListValue в качестве критерия для Field1: MyRange.AutoFilter Field:=1, Criteria1:=UListValue . Число поля здесь очень важно! Поскольку поле Регион является первым полем. При реализации этого макроса, вам необходимо изменить номер поля, чтобы соответствовать нужному полю.
- Каждый объект AutoFilter имеет свойство Range. Это свойство Range возвращает строки, к которым применяется Автофильтр, то есть он возвращает только те строки, которые отображаются в отфильтрованном наборе данных. Шаг 10 использует метод Copy для захвата вновь отфильтрованных строк и вставки их в новый лист.
Обратите внимание, на функцию UListValue. В частности, мы говорим Excel ограничить имя листа слева 31 символами в UListValue. Мы делаем это, потому что предел для имен листов составляет 31 символов. Все, что больше, чем 31 символов выдает ошибку. - Шаг 11 повторяет цикл, чтобы получить следующее значение из коллекции UList.
- Макрос заканчивается переходом к исходным автофильтрованным данным и очисткой всех фильтров.
Вам может быть интересно, как создать новую рабочую книгу для каждого элемента в автофильтре.
Это относительно легкое изменение. Просто замените код в шаге 10 на этот код.
'Шаг 10: Скопируйте автофильтрованный диапазон в новую книгу
ActiveSheet.AutoFilter.Range.Copy
Workbooks.Add.Worksheets(1).Paste
Cells.EntireColumn.AutoFit
ActiveWorkbook.SaveAs _
Filename:="C:\Temp\" & CStr(UListValue) & ".xlsx"
ActiveWorkbook.Close
Как использовать
Для реализации этого макроса, вы можете скопировать и вставить его в стандартный модуль:
- Активируйте редактор Visual Basic, нажав ALT + F11.
- Щелкните правой кнопкой мыши имя проекта / рабочей книги в окне проекта.
- Выберите Insert➜Module.
- Введите или вставьте код.