Установите автоматическую фильтрацию нескольких подстановочных знаков

Хотя в методе AutoFilter< можно использовать не более двух прямых подстановочных знаков на поле< /a> сопоставление шаблонов можно использовать для создания массива, который заменяет подстановочные знаки опцией Operator:=xlFilterValues. оператор Select Case помогает сопоставлять подстановочные знаки.

Второе поле представляет собой простое прямое соответствие Criteria1 и Criteria2 с Operator:=xlOr, объединяющим два критерия.

Sub multiWildcardFilter()
    Dim a As Long, aARRs As Variant, dVALs As Object

    Set dVALs = CreateObject("Scripting.Dictionary")
    dVALs.CompareMode = vbTextCompare

    With Worksheets("Sheet1")
        If .AutoFilterMode Then .AutoFilterMode = False
        With .Cells(1, 1).CurrentRegion
            'build a dictionary so the keys can be used as the array filter
            aARRs = .Columns(2).Cells.Value2
            For a = LBound(aARRs, 1) + 1 To UBound(aARRs, 1)
                Select Case True
                    Case aARRs(a, 1) Like "MK1454*"
                        dVALs.Add Key:=aARRs(a, 1), Item:=aARRs(a, 1)
                    Case aARRs(a, 1) Like "MK1467*"
                        dVALs.Add Key:=aARRs(a, 1), Item:=aARRs(a, 1)
                    Case aARRs(a, 1) Like "MK1879*"
                        dVALs.Add Key:=aARRs(a, 1), Item:=aARRs(a, 1)
                    Case Else
                        'no match. do nothing
                End Select
            Next a

            'filter on column B if dictionary keys exist
            If CBool(dVALs.Count) Then _
                .AutoFilter Field:=2, Criteria1:=dVALs.keys, _
                                      Operator:=xlFilterValues, VisibleDropDown:=False
            'filter on column E
            .AutoFilter Field:=5, Criteria1:="PROD", Operator:=xlOr, _
                                  Criteria2:="RISK", VisibleDropDown:=False

            'data is filtered on MK1454*, MK1467* or MK1879* (column B)
            'column E is either PROD or RISK
            'Perform work on filtered data here
        End With
        If .AutoFilterMode Then .AutoFilterMode = False
    End With

    dVALs.RemoveAll: Set dVALs = Nothing
End Sub

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

                       ^{Перед применением метода автофильтра}

                       ^{После применения автофильтра с несколькими подстановочными знаками}

¹ _{См. Can Advanced Filter критерии должны быть в VBA, а не в диапазоне? и Может ли автофильтр принимать как инклюзивные, так и неинклюзивные подстановочные знаки из ключей словаря? подробнее о добавлении исключений в набор фильтров словаря.}

Для использования частичных строк для исключения строк и включения пробелов вы должны использовать

'From Jeeped's code
Dim dVals As Scripting.Dictionary
Set dVals = CreateObject("Scripting.Dictionary")
dVals.CompareMode = vbTextCompare    


Dim col3() As Variant
Dim col3init As Integer

'Swallow row3 into an array; start from 1 so it corresponds to row
For col3init = 1 to Sheets("Sheet1").UsedRange.Rows.count
    col3(col3init) = Sheets("Sheet1").Range(Cells(col3init,3),Cells(col3init,3)).Value
Next col3init

Dim excludeArray() As Variant
'Partial strings in below array will be checked against rows
excludeArray = Array("MK1", "MK2", "MK3")

Dim col3check As Integer
Dim excludecheck as Integer
Dim violations As Integer
For col3check = 1 to UBound(col3)
    For excludecheck = 0 to UBound(excludeArray) 
         If Instr(1,col3(col3check),excludeArray(excludecheck)) <> 0 Then
             violations = violations + 1
             'Sometimes the partial string you're filtering out for may appear more than once.
         End If
    Next col3check

    If violations = 0 and Not dVals.Exists(col3(col3check)) Then
         dVals.Add Key:=col3(col3check), Item:=col3(col3check) 'adds keys for items where the partial strings in excludeArray do NOT appear
    ElseIf col3(col3check) = "" Then
         dVals.Item(Chr(61)) = Chr(61) 'blanks
    End If
    violations = 0
Next col3check    

Идея dVals.Item(Chr(61)) = Chr(61) пришла из другого ответа Jeeped здесь Множественные критерии фильтрации для пробелов и чисел с использованием подстановочных знаков в одном и том же поле просто не работают

Попробуйте ниже код:

не более 2 подстановочных знаков для Criteria1 работает. Перейдите по этой ссылке

Sub AutoFilter()

    With ThisWorkbook.Sheets("sheet1").Range("A:E")
        .AutoFilter Field:=2, Criteria1:=Array("*M1454*", "*M1467*"), Operator:=xlFilterValues
        .AutoFilter Field:=5, Criteria1:="=PROD", Operator:=xlOr, Criteria2:="=RISK"
    End With

End Sub