Views: 656
Как копировать результаты отбора значений фильтром на новый лист в VBA.
Тема нашего сегодняшнего занятия – практика работы в VBA Excel с объектами рабочего листа. Сегодня рассмотрим на примере, как копировать результаты отбора значений фильтром на новый лист, используя возможности VBA. Перед нами стоит следующая задача. Имеется таблица, для которой регулярно применяется фильтр по определенным параметрам. Требуется скопировать результаты отбора значений фильтром на новый лист. Какие значения будут отобраны фильтрацией, и какие соответственно строки исходной таблицы потребуется копировать, заранее неизвестно.
Приступаем к работе. Вначале определимся с алгоритмом действий программы. Для того чтобы выполнить копирование результата фильтра на новый лист с помощью VBA, требуется выполнить последовательно следующие шаги:
- Определиться с переменными. Если переменные заранее не указаны, это приводит к расходу памяти. Кроме этого, если переменные создаются в ходе выполнения макроса, это приводит к путанице и дублированию.
2. Определить обрабатываемый диапазон на листе, где находится таблица с фильтром, который будет обработан.
3. Отобрать строки для копирования из исходной таблицы.
4. Создать новый лист и задать для него имя.
5. Копируем выбранные данные вместе с заголовком таблицы на новый лист
Как уже сказано выше, вначале определяемся с переменными. Нам нужны две переменные типа string для хранения имен исходного и нового листа. Назовем их OldSheet NewSheet. Кроме этого, нам потребуется несколько переменных типа Integer.
Номер строки и номер колонки для первой ячейки исходной таблицы зададим как StartRow и StartCol соответственно. Таким же образом определим, как EndRow и EndCol номер строки и номер колонки для последней ячейки диапазона таблицы, используемого для обработки. Тип для обоих параметров укажем как Integer. Также потребуются отдельные переменные типа integer для хранения количества строк таблицы, для переменной-счетчика в цикле выбора отфильтрованных данных, и для хранения количества отобранных строк. Обозначим их по традиции как n, i и j. Дополнительно для хранения адресов, выбранных в итоге для копирования строк, массив MyMas. Получаем следующие операторы
Dim OldSheet As String, NewSheet As String
Dim i As Integer, j As Integer, n As Integer
Dim StartRow As Integer, EndRow As Integer
Dim StartCol As Integer, EndCol As Integer
Dim MyMas() As String
Сразу обратите внимание, что, если размеры таблицы, например, количество строк, превышает 32768, то вместо типа Integer необходимо применить тип Long.
На втором шаге определяем границы нашего диапазона. Мы можем сразу обратиться к UsedRange или CurrentRegion. Однако это ничего не даст, так как нужно не просто выделить исходную таблицу, а проверить каждую ячейку в ней. Существует несколько способов нахождения номера строки и столбца для первой и последней ячейки диапазона. Простейший основывается на том, что номер строки для последней ячейки заданного диапазона равен сумме номера строки первой ячейки этого диапазона и количества строк в этом диапазоне за минусом единицы. Такая же ситуация с номером столбца последней ячейки диапазона.
Начинаем заполнять переменные. Номер строки и номер столбца первой ячейки можно найти через свойства диапазона Row и Column, количество строк и колонок определяются как Rows.Count и Columns.Count соответственно. В результате получаем такую запись
ActiveSheet.UsedRange.Select
StartRow = Selection.Row: EndRow = StartRow + Selection.Rows.Count – 1
StartCol = Selection.Column: EndCol = StartCol + Selection.Columns.Count – 1
Далее мы заносим в переменную OldSheet название текущего листа и определяем значения переменных j и n
OldSheet = ActiveSheet.Name
j = 0: n = Selection.Rows.Count
На третьем шаге создадим перечень строк, которые необходимо скопировать. Вначале создадим массив, где будут храниться эти адреса. Предположим, что наибольшее количество элементов в этом массиве будет в ситуации, когда таблица копируется целиком. В итоге получаем оператор
ReDim MyMas(1 to n)
Теперь давайте разберемся с определением важных строк. На самом деле логика простая. Отфильтрованные строки будут видимы, а пропущенные строки скрыты. Определить же, видим диапазон или нет можно по свойству hidden, задаваемому как для строк поверяемого диапазона, так и для столбцов. Будем проверять это свойство для строк. Номер текущей строки выделения (не забываем, что таблица полностью выделена), занесем в переменную i, таким образом, диапазон проверяемой строки выделения указываем, используя такое свойство определения диапазонов как Range(Cells(I,StartCol),Cells(I, EndCol). Однако такое подробное определение для проверки не требуешься, так как свойство EntireRow.Hiden присутствует и у отдельных ячеек. Однако в массив MyMas заносим целиком адрес строки исходного диапазона, не скрытой в результате фильтра.
For i = StartRow To EndRow
If Cells(i, StartCol).EntireRow.Hidden = False Then
j = j + 1
MyMas(j) = Range(Cells(i, StartCol), Cells(i, EndCol)).Address
End If
Next
В результате массив MyMas станет содержать адреса строк таблицы, отобранных фильтром.
Переходим к следующему шагу. Создадим лист, в который будем копировать результат фильтра по значениям из массива. Заранее название будущего листа неизвестно. Задавать название статически неудобно, так как макрос возможно применится в одном и том же файле несколько раз. Автоматическая генерация наименования тоже неудобна. Поэтому занесем в переменную NewSheet, предназначенную для названия нового листа, значение, полученное с помощью функции InputBox. В данном случае применим только один обязательный аргумент – текстовый запрос.
Sheets.Add after:=ActiveSheet
NewSheet = InputBox(“Write new Sheet Name”)
ActiveSheet.Name = NewSheet
Остался последний шаг. Переходим на исходный лист, выделяем диапазон, используя адреса из массива MyMas. Копируем выделенный диапазон и возвращаемся в добавленный лист. Выделяем ячейку первого столбца с номером строки, равным номеру проверяемого элемента из MyMas и выполняем вставку. Так будем делать до тех пор, пока не переберем каждый адрес ячеек исходного листа, занесенные в массив.
For i = 1 To j
Sheets(OldSheet).Select
Range(MyMas(i)).Copy
Sheets(NewSheet).Select
Cells(i + 1, 1).Select
ActiveSheet.Paste
Next
Последний момент. Во время копирования желательно отключить постоянное обновление рабочего окна. Так же желательно после копирования вернуться на исходный лист для продолжения работы. Поэтому предыдущий код лучше переделать следующим образом.
Application.ScreenUpdating = False
For i = 1 To j
Sheets(OldSheet).Select
Range(MyMas(i)).Copy
Sheets(NewSheet).Select
Cells(i + 1, 1).Select
ActiveSheet.Paste
Next
Sheets(OldSheet).Select
Applilcation.ScreenUdating = True
Полностью же код выглядит так
Sub Get_FilterData()
On Error Resume Next
Dim OldSheet As String, NewSheet As String
Dim i As Integer, j As Integer, n As Integer
Dim StartRow As Integer, EndRow As Integer
Dim StartCol As Integer, EndCol As Integer
Dim MyMas() As String
ActiveSheet.UsedRange.Select
StartRow = Selection.Row: EndRow = StartRow + Selection.Rows.Count – 1
StartCol = Selection.Column: EndCol = StartCol + Selection.Columns.Count – 1
OldSheet = ActiveSheet.Name
j = 0: n = Selection.Rows.Count
ReDim MyMas(1 to n)
For i = StartRow To EndRow
If Cells(i, StartCol).EntireRow.Hidden = False Then
j = j + 1
MyMas(j) = Range(Cells(i, StartCol), Cells(i, EndCol)).Address
End If
Next
Sheets.Add after:=ActiveSheet
NewSheet = InputBox(“Write new Sheet Name”)
ActiveSheet.Name = NewSheet
Application.ScreenUpdating = False
For i = 1 To j
Sheets(OldSheet).Select
Range(MyMas(i)).Copy
Sheets(NewSheet).Select
Cells(i + 1, 1).Select
ActiveSheet.Paste
Next
Sheets(OldSheet).Select
Applilcation.ScreenUdating = True
End Sub
В конце занятия хотелось поговорить о некоторых моментах. Прежде всего заметим, что отобрать видимые ячейки можно методом SpecialCells, о котором поговорим позже. Однако этот метод имеет ряд недостатков. Прежде всего он не работает, если выбрана только одна ячейка. Кроме этого, если в диапазоне нет видимых ячеек, другими словами, если фильтр не нашел нужную информацию, то получим ошибку. Отслеживать каждый вариант будущей ошибки сложно, так как заранее неизвестно условие применяемого фильтра. Приведенный же нами код универсален и сработает в любой ситуации. Исключение – наличие на листе нескольких таблиц. Чтобы этого избежать, нужную таблицу придется выделать вручную после применения к ней фильтра. В указанном выше коде тогда нужно будет удалить строку
ActiveSheet.UsedRange.Select
После чего макрос заработает.
Второе, о чем нужно сказать – о сложности кода. Приведенный в конце код действительно кажется сложным, особенно для новичков. Но если поступать пошагово и последовательно, то оказывается, что ничего сложного нет. Специально повторим это для новичков. Никогда не бойтесь сложного кода. Разбейте задачу, которую должен выполнить макрос и начните решать ее поэтапно. Написание кода станет значительно легче, к тому же сразу проявятся возможные ошибки при написании.
И третий момент. При изучении языков программирования часто встречается ситуация, когда изучаемая процедура, функция, метод и так далее кажутся ненужными. На самом деле, каким бы абсурдным не казался изучаемый материал, знать материал надо. Сегодня мы, например, убедились, что тот же массив используется не только для хранения абстрактных данных, но и для копирования нужных ячеек.
Наш же урок подошел к концу. Желаем всем хорошего настроения и удачного дня. Встретимся на занятиях в учебном центре, где вас ждет гораздо больше интересных моментов в изучении VBA
