设置自动过滤多个通配符答案

【问题标题】：Set Auto Filtering multiple wildcards设置自动过滤多个通配符
【发布时间】：2013-05-17 06:32:31
【问题描述】：

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

（从左边开始是A列）名称 * BDevice * 数量 * 销售* 所有者

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

这是我写的代码：

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

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

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

【问题讨论】：

您能告诉我您的数据所在的工作表名称吗？
AutoFilter 是一个内置的 VBA 术语。当我从工作表对象中的@Santosh 执行代码时，这会在我的机器上导致编译错误。重命名 Sub 可解决此问题。

标签： vba excel dictionary autofilter

【解决方案1】：

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

第二个字段是一个简单的 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 criteria be in the VBA rather than a range? 和Can AutoFilter take both inclusive and non-inclusive wildcards from Dictionary keys?，了解更多关于将排除项添加到字典过滤器集的信息。}

【讨论】：

【解决方案2】：

对于使用部分字符串来排除行并包含你应该使用的空白

'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 在此处的其他答案 Multiple Filter Criteria for blanks and numbers using wildcard on same field just doesn't work

【讨论】：

【解决方案3】：

试试下面的代码：

Criteria1 的最大 2 个通配符表达式有效。参考这个link

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

【讨论】：