Возможно ли отфильтровать значения в столбце на одном листе, по частичному совпадению в значениях другого листа?
Пробовала редактировать код записанного макроса, но результата это не принесло:
Sub Макрос_test()
ActiveSheet.Range("$A$1:$D$17394").AutoFilter Field:=4, Criteria1:= _
Array("=**Лист1!A1:A5**"), Operator:=xlAnd
End Sub
При явном указании только двух условий макрос работает и фильтрует все строки, которые содержат слова "здание" или "А/М":
Sub Макрос555()
ActiveSheet.Range("$A$1:$D$17394").AutoFilter Field:=4, Criteria1:= _
"=**здание**", Operator:=xlOr, Criteria2:="=**А/М**"
End Sub
Прошу помочь с созданием макроса, который отфильтрует список по списку (массиву значений) на другом листе.
Такой возможности нет в экселе: нельзя в автофильтре фильтровать по частичному совпадению по трём и более фразам - максимум две. В том числе, нельзя делать фильтр по частичному совпадению по трём и более фразам с помощью массива.
По трём и более фразам можно фильтровать по полному совпадению.
Предлагаю обходной вариант. Макрос собирает в массив данные по частичному совпадению без использования автофильтра, а затем подставляет массив в автофильтр и автофильтр фильтрует по полному совпадению.
Макрос
Option Explicit
Sub jjj()
' - -
' - порядковый номер фильтруемого столбца целевого диапазона
Const l_FILTERED_FIELD As Long = 1
' - -
Dim rngData As Range, arrData(), i&, j&, n&
' - -
' - массив ключевых слов для фильтрации
Dim arrWords(): arrWords = VBA.Array("Апельсин", "Груша", "Яблоко"): n = UBound(arrWords, 1)
' - -
' - массив для целевых значений (отобранным по ключевым словам)
Dim dictFilterKeys As Object: Set dictFilterKeys = CreateObject("Scripting.Dictionary")
' - -
With ActiveSheet
' - -
' - если на активном листе вкл. автофильтр, то выкл. его
If .AutoFilterMode Then .AutoFilterMode = False
' - -
' - целевой диапазон для фильтрации
Set rngData = .Cells(1).CurrentRegion
' - -
End With 'ActiveSheet
' - -
' - содержимое целевого столбца из диапазона в массив
arrData = rngData.Columns(l_FILTERED_FIELD).Value
' - -
' - цикл по массиву со 2й строки, т.к. 1я - заголовок
For i = 2 To UBound(arrData, 1)
' - -
' - если текущего элем. массива нет в словаре, то
If Not dictFilterKeys.Exists(arrData(i, 1)) Then
' - -
' - цикл по клчевым словам
For j = 0 To n
' - -
' - если в текущем элем. массива имеется текущее ключевое слово, то _
вносим текущем элем. массива в словарь (значение не важно, потому = 1) _
и выходим из данного цикла
If InStr(1, arrData(i, 1), arrWords(j), vbTextCompare) > 0 Then dictFilterKeys(arrData(i, 1)) = 1: Exit For
' - -
Next j
' - -
End If 'Not dictFilterKeys.Exists(arrData(i, 1))
' - -
Next i
' - -
' - если словарь не пуст, то фильтруем по отобранным ключевым значениям
If dictFilterKeys.Count Then _
rngData.AutoFilter Field:=l_FILTERED_FIELD, Criteria1:=dictFilterKeys.Keys, Operator:=xlFilterValues Else _
MsgBox "Нечего фильтровать!", vbExclamation
' - -
End Sub