Когда вы работаете с большими объемами данных, нельзя представить себе эту деятельность без фильтров. Однозначно, что в Excel разработан очень мощный и удобный инструмент фильтрации, который позволяет выбирать определенные данные из диапазона. А с приходом Excel 2007 добавилась возможность выбирать данные с определенной заливкой. Все это облегчает рабочие будни Excel юзеров и упрощает жизнь. Однако, есть еще один элемент, который пока еще не реализован в стандартных фильтрах Excel, но приятно было бы иметь в арсенале, я говорю о фильтрации с помощью символов подстановки, который мы попытаемся сегодня реализовать с помощью VBA.
Оригинальную статью можно найти на сайте https://yoursumbuddy.com/
В данной статье описан способ создания фильтра на основе формы ListBox на VBA. Фильтр использует оператор Like, для поиска соответствий в заданном диапазоне. К примеру, набрав в фильтре celti, программа вернет мне значение Exceltip, но это не самое главное, так как стандартный фильтр позволяет проводить подобные манипуляции. Гораздо интереснее, что оператор Like позволяет использовать символы подстановки, таким образом введя в текстовое поле значение /*/201? , Excel вернет все даты начиная с 2010 года. Плюс ко всему, данный фильтр позволяет задавать чувствительность к регистру и отбирать уникальные значения.
Внизу показаны принципы работы фильтра на примере списка женских имен с добавлением выбора уникальных значений и чувствительности к регистру. Обратите внимание, щелчок на имени в фильтре позволяет выбирать его в списке.
Ниже отображен макрос, который запускается каждый раз, когда меняется значение в текстовом поле фильтра или происходит щелчок на один из элементов списка в фильтре.
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.
Для лучшего понимания прикладываю файл с макросом.
Статья хорошая, но практического применения не имеет.
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 прекрасно справляется и с этой задачей.
Только начал читать блог. Оказалось что я мало что знаю об Экселе. Подача материала радует, всё понятно.
День добрый Ренат,
подскажите пож-та как сделать такой же фильтр только который сразу находится на рабочем листе (отображает 10-15 первых значений) и имеет возможность фильтрации как у вас. то есть такой же фильтр только сразу на странице а не вызываемый через кнопку?
Добрый день! Возникла задача, не знаю как реализовать). Есть 2 массива данных. Первый: таблица из 2х столбцов: номер карты и дата издания (Список карт находящихся на судне). Второй массив это таблица вообще всех изданных карт. Содержит столбцы: номер карты, дата последнего издания, масштаб, название. Задача состоит в том чтобы по номерам карт из первого массива вытащить данные из второго массива. И если дата издания не совпадает(т.е. Вышла новое издание карты) пдсветить номер карты в первом массиве.
Добрый вечер. Подскажите курс по макросам. Хочу пройти.
Добрый день, Вероника. Ссылка на мой курс по макросам https://www.udemy.com/course/excel_vba/?referralCode=A09F2C749F0206BC6FB8