Иногда встречаются случаи, когда необходимо в уже готовую таблицу Excel добавить фильтр или же когда необходимо к уже готовой таблице с установленными фильтрами присоединить еще один столбец. Однако не всегда это происходит безболезненно и так быстро как хотелось бы, особенно когда таблица имеет большое количество столбцов и имеет сложную структуру, в частности объединённые ячейки.
Давайте посмотрим на следующий пример:
Как можно заметить, при попытке добавить фильтр в таблицу, где есть объединённые ячейки, фильтр применяется для верхней строки шапки таблицы и к тому же не к каждому столбцу. А нам требуется добавить фильтрацию, которая бы размещалась в нижней части шапки, и охватывала бы все столбцы таблицы.
И так, что бы нам пришлось сделать в таком случае, если бы мы делали всё вручную? Давайте составим пошаговый алгоритм:
-
Выяснить, есть ли в шапке таблицы объединенные ячейки. Если есть, то необходимо определить, какие именно.
-
Снять объединение со всех ячеек шапки таблицы (в нашем примере оно имеется в столбцах A, H, O)
-
Выделить весь диапазон данных таблицы, включая нижнюю строку шапки (в нашем случае это диапазон [A3:O7])
-
Применить фильтр
-
Объединить те диапазоны ячеек, с которых ранее было снято объединение в п.1 (в нашем случае это [A1:A3],[H1:H3],[O1:O3])
Наверняка, многие сталкивались с такими ситуациями когда-нибудь. Но существует ли более быстрый и лёгкий способ сделать это? Давайте попробуем проделать то же самое с помощью т.н. макросов – кода на языке Visual Basic (for Applications).
Первое с чего начнём – создание процедуры в редакторе VBE. Назовем процедуру CreateHeadingFilter. Весь последующий код (за исключением отдельных функций и процедур) будем размещать именно в ней.
Теперь, давайте пройдем по вышеописанному алгоритму от п.1 до п.5 и попробуем проделать то же самое, только с помощью кода.
Выясняем наличие объединенных ячеек и сохраняем их адреса в память. На данном этапе мы будем использовать словарь (Scripting.Dictionary) из встроенной библиотеки “scrrun.dll”.
Dim dicAddr As Object
Dim sh As Worksheet
Dim vAddrList As Variant
Dim rngWhole As Range
Dim rngCell As Range
Dim sAddress As String
Set rngWhole = Selection
Set dicAddr = CreateObject("Scripting.Dictionary")
'//Reading current structure
For Each rngCell In rngWhole
With rngCell
If .MergeCells Then
sAddress = .MergeArea.Address
If Not dicAddr.exists(sAddress) Then
dicAddr.Add Key:=sAddress, Item:=vbNullString
End If
End If
End With
Next rngCell
Перед запуском процедуры пользователь должен выделить шапку таблицы, в которой впоследствии будет установлен фильтр. Выделению мы присваиваем задекларированный диапазон rngWhole. Далее в цикле мы перебираем все элементы данного диапазона в поисках объединённых ячеек. Как только объединенные ячейки нашлись, их адрес записывается в текстовую переменную sAddress и добавляется в словарь. После этого переходим к действиям из п.2
- Отмена объединений ячеек во всей шапке таблицы Далее необходимо “разобъединить” выделенные ячейки (см. строка 9), адреса которых мы записали ранее в словарь. Также мы запомним в переменные границы шапки таблицы – для того, чтобы в дальнейшем понимать в какой строке у нас находится низ шапки таблицы и с какого по какой столбец необходимо проставлять фильтр
Dim sh As Worksheet
Dim lRowHeading As Long
Dim lRow As Long
Dim iLCol As Integer
Dim iRCol As Integer
'//Unmerging selection
With rngWhole
.UnMerge
lRowHeading = .Row + .Rows.Count - 1
iRCol = .Column + .Columns.Count - 1
iLCol = .Column
Set sh = .Parent
End With
Set rngWhole = Nothing
3-4. Установка фильтра в таблице Пункты 3 и 4 были выделены специально отдельными блоками, чтобы отделить сам процесс установки фильтров от подготовительных операций. При написании кода, т.к. мы заблаговременно сохранили основные сведения о границах шапки таблицы (столбец_начало, столбец_конец, строка_начало, строка_конец), то у нас часть работы отпадает и остается установить фильтр, как таковой.
Private Sub ApplyAutofilter(ByRef sh As Worksheet, _
ByVal LUpperRow As Long, _
ByVal iLeftCol As Integer, _
ByVal iRightCol As Integer)
Dim lLowerRow As Long
'//Setting filter
With sh
lLowerRow = .UsedRange.Rows.Count + .UsedRange.Row - 1
If .AutoFilterMode = True Then
If .FilterMode Then: .ShowAllData
.AutoFilterMode = False
End If
.Range(.Cells(LUpperRow, iLeftCol), .Cells(lLowerRow, iRightCol)).AutoFilter
End With
End Sub
Так как при установке фильтра проверяются различные условия, не связанные с целью основного кода, то я выделил весь код, связанный с установкой фильтров в отдельную функцию ApplyAutofilter. К тому же данная функция может быть использована в дальнейшем в других ситуациях, потому как ни одна из её строк не специфична для конкретной книги, листа и т.д. – функция получает необходимые параметры и проставляет фильтр в диапазоне с заданными координатами. В данной функции хотелось бы отметить один момент – нахождение последней строки (переменная lLowerRow):
Почему-то, нигде в литературе и в интернете не встречал, чтобы при нахождении последнего рядка страницы добавляли бы “+ UsedRange.Row – 1“. Хотя на практике очень часто встречался с ситуациями, когда данные на листе начинаются не со строки №1, а допустим, с третьей. Тогда, если у нас, к примеру 10 строк данных, то конструкция UsedRange.Rows.Count (как обычно используется), вернет результат “10”, но последняя строка листа в действительности будет не десятая(!), а двенадцатая. Именно поэтому я рекомендую делать поправку на первую строку используемого диапазона и при нахождении номера последней строки всегда использовать конструкцию UsedRange.Rows.Count + UsedRange.Row – 1
- Объединение ячеек шапки таблицы Проделав все процедуры из пунктов 1-4 мы получили бы на выходе таблицу с фильтрацией, но с удручающим видом самой шапки таблицы – ранее объединенные ячейки теперь “не влазят” в таблицу и скрываются где-то между строками. На ничего не остается, как вернуть красивое форматирование таблице, к тому же, перечень ячеек, который мы “разобъединяли” уже сохранён в объекте словаря.
Dim vAddrList As Variant
Dim j As Long
If dicAddr.Count > 1 Then
'//Merging cells in Heading area
vAddrList = dicAddr.keys
For j = LBound(vAddrList) To UBound(vAddrList)
Set rngCell = sh.Range(vAddrList(j))
rngCell.Merge
Next j
End If
В переменную vAddrList заносим перечень адресов из словаря и пробежав по каждому из адресов, мы применяем объединение ячеек.
После объединения всех кусочков кода в одно целое, и после добавления небольших оптимизаций и проверок, получим финальную версию кода (в текстовом файле в конце статьи). Вот, в принципе и всё! Ничего сверхъестественного или особо сложного здесь нет – всё делается довольно прямолинейно и быстро.
Готовый код можно скачать в прилагаемом текстовом файле: