Расширенный фильтр в Excel с символами подстановки и уникальными значениями на VBA

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

Оригинальную статью можно найти на сайте http://yoursumbuddy.com/

В данной статье описан способ создания фильтра на основе формы ListBox на VBA. Фильтр использует оператор Like, для поиска соответствий в заданном диапазоне. К примеру, набрав в фильтре celti, программа вернет мне значение Exceltip, но это не самое главное, так как стандартный фильтр позволяет проводить подобные манипуляции. Гораздо интереснее, что оператор Like позволяет использовать символы подстановки, таким образом введя в текстовое поле значение /*/201? , Excel вернет все даты начиная с 2010 года. Плюс ко всему, данный фильтр позволяет задавать чувствительность к регистру и отбирать уникальные значения.

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

96-1-Расширенный фильтр Excel

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
Sub ResetFilter()
Dim rngTableCol As Excel.Range
Dim varTableCol As Variant
Dim RowCount As Long
Dim collUnique As Collection
Dim FilteredRows() As String
Dim i As Long
Dim ArrCount As Long
Dim FilterPattern As String
Dim UniqueValuesOnly As Boolean
Dim UniqueConstraint As Boolean
Dim CaseSensitive As Boolean

'звездочка возвращает все значения списка
If Not ValidLikePattern(Me.txtFilter.Text) Then
Exit Sub
End If
FilterPattern = "*" & Me.txtFilter.Text & "*"

UniqueValuesOnly = Me.chkUnique.Value
CaseSensitive = Me.chkCaseSensitive

'используется, если Уникальные значения равно ИСТИНА
Set collUnique = New Collection
Set rngTableCol = loActive.ListColumns(1).DataBodyRange
'обратите внимание, функция Transpose не работает с больше, чем 65536 строчек
varTableCol = Application.WorksheetFunction.Transpose(rngTableCol.Value)
RowCount = UBound(varTableCol)
ReDim FilteredRows(1 To 2, 1 To RowCount)
For i = 1 To RowCount
If UniqueValuesOnly Then
On Error Resume Next
'сброс цикла
UniqueConstraint = False
'не добавляет, если не уникальное значение
collUnique.Add Item:="test", Key:=CStr(varTableCol(i))
If Err.Number <> 0 Then
UniqueConstraint = True
End If
On Error GoTo 0
End If

If Not UniqueConstraint Then
'Оператор Like чувствителен к регистру,
'поэтому необходимо использовать команду Lcase, если галка не стоит
If (Not CaseSensitive And LCase(varTableCol(i)) Like LCase(FilterPattern)) _
Or (CaseSensitive And varTableCol(i) Like FilterPattern) Then
'добавить в массив, если пункт из ListBox соответствует фильтру
ArrCount = ArrCount + 1
'в ListBox есть скрытый столбец для нумерования элементов
FilteredRows(1, ArrCount) = i
FilteredRows(2, ArrCount) = varTableCol(i)
End If
End If
Next i
If ArrCount > 0 Then
'удаляем пустые элементы массива
'ListBox не может содержать более 65536 элементов
ReDim Preserve FilteredRows(1 To 2, 1 To Application.WorksheetFunction.Max(ArrCount, 65536))
Else
Erase FilteredRows
End If
If ArrCount > 1 Then
Me.lstDetail.List = Application.WorksheetFunction.Transpose(FilteredRows)
Else
Me.lstDetail.Clear
'добавляем отдельно, если найден только один элемент
If ArrCount = 1 Then
Me.lstDetail.AddItem FilteredRows(1, 1)
Me.lstDetail.List(0, 1) = FilteredRows(2, 1)
End If
End If
End Sub

В этом макросе использована возможность элемента Collection хранить только уникальные значения. Если на форме установлена галочка Уникальные, то макрос проверит его прежде, чем поместит в массив ListBox.

Переменная FilterPattern имеет звездочки в начале и конце строки. Это позволяет находить записи внутри таблицы.

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

1
2
3
4
5
6
7
8
9
Private Sub lstDetail_Change()
GoToRow
End Sub

Sub GoToRow()
If Me.lstDetail.ListCount > 0 Then
Application.Goto loActive.ListRows(Me.lstDetail.Value).Range.Cells(1), True
End If
End Sub

Скорость макроса достаточно приемлема для таблиц с менее чем 10000 строками. Но даже с превышением этого порога, макрос будет работать, главное, чтобы число строк было менее 65536.

Для лучшего понимания прикладываю файл с макросом.


4 комментария

  1. Статья хорошая, но практического применения не имеет.
    1. Символы подстановки * и ? можно использовать в стандартом фильтре Excel 2010 и в формулах.
    Например, в фильтре пишем *По?та России* и выводятся строки содержащие Почта России или Поста России.
    Тоже самое с формулами:
    =СУММЕСЛИМН(data!$L:$L;data!$A:$A;$N50;data!$C:$C;»*По?та России*»)
    или так:
    =СУММЕСЛИМН(data!$L:$L;data!$A:$A;ЕСЛИ($B$2=»Все поставщики»;»*»;$B$2))
    2. Если бы уникальные значения выводились в диапазоне данных, а не в ListBox-е, еще можно думать о применении, хотя расширенный фильтр Excel 2010 прекрасно справляется и с этой задачей.

  2. День добрый Ренат,
    подскажите пож-та как сделать такой же фильтр только который сразу находится на рабочем листе (отображает 10-15 первых значений) и имеет возможность фильтрации как у вас. то есть такой же фильтр только сразу на странице а не вызываемый через кнопку?

  3. Добрый день! Возникла задача, не знаю как реализовать). Есть 2 массива данных. Первый: таблица из 2х столбцов: номер карты и дата издания (Список карт находящихся на судне). Второй массив это таблица вообще всех изданных карт. Содержит столбцы: номер карты, дата последнего издания, масштаб, название. Задача состоит в том чтобы по номерам карт из первого массива вытащить данные из второго массива. И если дата издания не совпадает(т.е. Вышла новое издание карты) пдсветить номер карты в первом массиве.

Добавить комментарий

Ваш e-mail не будет опубликован. Обязательные поля помечены *