vba 设置自动过滤多个通配符

Set Auto Filtering multiple wildcards

提问by Thomas

Right now I am doing coding to set a filter for a data chart. Basically, I don't know how to post the data sheet up here so just try to type them ):

现在我正在编写代码来为数据图表设置过滤器。基本上，我不知道如何在此处发布数据表，因此只需尝试键入它们）：

(starting from the left is column A) Name * BDevice * Quantity * Sale* Owner

（从左边开始是 A 列） Name * BDevice * Quantity * Sale* Owner

Basically I need to filter out for 2 column: -The BDevice with any word contain "M1454" or "M1467" or "M1879" (It means that M1454A or M1467TR would still fit in) -The Owner with PROD or RISK

基本上我需要过滤掉 2 列：-带有任何单词的 BDevice 包含“M1454”或“M1467”或“M1879”（这意味着 M1454A 或 M1467TR 仍然适合）-具有 PROD 或风险的所有者

Here is the code I wrote:

这是我写的代码：

Sub AutoFilter()

  ActiveWorkbook.ActiveSheet..Range(B:B).Select

  Selection.Autofilter Field:=1 Criteria1:=Array( _
      "*M1454*", "*M1467*", "*M1879*"), Operator:=xlFilterValues

  Selection.AutoFilter Field:=4 Criteria1:="=PROD" _
      , Operator:=xlOr, Criteria2:="=RISK"

End Sub

When I run the code, the machine returns error 1004 and the part which seems to be wrong is the Filter part 2 ( I am not sure about the use of Field, so I can not say it for sure)

当我运行代码时，机器返回错误1004，似乎错误的部分是Filter part 2（我不确定Field的使用，所以我不能肯定地说）

Edit; Santosh:When I try your code, the machine gets error 9 subscript out of range. The error came from the with statement. (since the data table has A to AS column so I just change to A:AS)

编辑; Santosh：当我尝试你的代码时，机器得到错误 9 下标超出范围。错误来自 with 语句。（因为数据表有 A 到 AS 列，所以我只是更改为 A:AS）

回答by Thomas

While there is a maximum of two direct wildcards per field in the AutoFilter method, pattern matching can be used to create an array that replaces the wildcards with the Operator:=xlFilterValuesoption. A Select Case statementhelps the wildcard matching.

虽然AutoFilter 方法中每个字段最多有两个直接通配符，但可以使用模式匹配来创建一个数组，用Operator:=xlFilterValues选项替换通配符。一个Select Case语句帮助通配符匹配。

The second field is a simple Criteria1 and Criteria2 direct match with a Operator:=xlOrjoining the two criteria.

第二个字段是一个简单的 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

If exclusions1 are to be added to the filtering, their logic should be placed at the top of the Select.. End Select statement in order that they are not added through a false positive to other matching criteria.

如果要将排除项 1 添加到过滤中，则它们的逻辑应放置在 Select.. End Select 语句的顶部，以便它们不会通过误报添加到其他匹配条件中。

????????
????????????????????????^{Before applying AutoFilter Method}

????????? ??????????????????????????? ^{应用自动筛选方法之前}

????????
????????????????????????^{After applying AutoFilter w/ multiple wildcards}

????????? ??????????????????????????? ^{应用带有多个通配符的自动过滤器后}

---

---

1 _{See Can Advanced Filter criteria be in the VBA rather than a range?and Can AutoFilter take both inclusive and non-inclusive wildcards from Dictionary keys?for more on adding exclusions to the dictionary's filter set.}

1_{请参阅高级筛选条件可以在 VBA 中而不是范围内吗？和AutoFilter 可以从字典键中获取包含和非包含通配符吗？有关向字典的过滤器集添加排除项的更多信息。}

回答by S. Pan

For using partial strings to exclude rows and include blanks you should use

要使用部分字符串排除行并包含空格，您应该使用

'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    

The dVals.Item(Chr(61)) = Chr(61) idea came from Jeeped's other answer here Multiple Filter Criteria for blanks and numbers using wildcard on same field just doesn't work

dVals.Item(Chr(61)) = Chr(61) 的想法来自 Jeeped 的其他答案， Multiple Filter Criteria for blanks and numbers using wildcard on same field just not work

回答by Santosh

Try below code :

试试下面的代码：

max 2 wildcard expression for Criteria1 works. Refer this link

Criteria1 的最多 2 个通配符表达式有效。参考这个链接

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