使用Dictionary实现多条件AutoFilter时遇类型不匹配错误求助

错误原因说明 #

你遇到的「类型不匹配错误」是因为Application.Match在未找到匹配项时会返回错误值，直接用If Application.Match(...) Then判断时，错误值无法转换为布尔值，导致类型不匹配。此外原代码的数据源范围赋值也存在逻辑问题，会跳过部分有效行。

修正后的Dictionary方案代码 #

Sub AutoFilter_With_Multiple_Criteria()
    Const filter_Column As Long = 2
    Const filter_Delimiter As String = " "
    
    Dim filter_Criteria() As Variant
    filter_Criteria = Array("Cathodic Protection", "C.P", "Riser")
    
    Dim ws As Worksheet: Set ws = ActiveSheet
    Dim rg As Range
    
    ' 修正数据源范围：UsedRange排除表头，直接取数据区域
    Set rg = ws.UsedRange.Offset(1).Resize(ws.UsedRange.Rows.Count - 1)
    If rg.Rows.Count = 0 Then Exit Sub ' 无数据时退出
    
    Dim arr() As Variant
    arr = rg.Columns(filter_Column).Value ' 将目标列数据写入数组
    
    Dim dict As New Dictionary
    Dim subStrings() As String, r As Long, i As Long, rStr As String
    
    For r = 1 To UBound(arr, 1)
        rStr = CStr(arr(r, 1)) ' 强制转换为字符串，避免非文本类型报错
        If Len(rStr) > 0 Then
            subStrings = Split(rStr, filter_Delimiter)
            For i = 0 To UBound(filter_Criteria)
                ' 用IsError判断匹配结果：未报错则说明找到匹配
                If Not IsError(Application.Match(filter_Criteria(i), subStrings, 0)) Then
                    If Not dict.Exists(rStr) Then
                        dict(rStr) = Empty
                    End If
                    Exit For ' 找到一个匹配即可，无需继续循环判断
                End If
            Next i
        End If
    Next r
    
    If dict.Count > 0 Then
        rg.AutoFilter Field:=filter_Column, Criteria1:=dict.Keys, Operator:=xlFilterValues
    Else
        ' 无匹配结果时清除筛选
        rg.AutoFilter Field:=filter_Column
    End If
End Sub

关键修改点 #

• 用Not IsError(Application.Match(...))替代直接判断，避免错误值导致的类型不匹配
• 修正数据源范围的赋值逻辑，确保包含所有有效数据行
• 用CStr()强制转换单元格内容为字符串，处理非文本类型的单元格
• 找到匹配后添加Exit For，减少不必要的循环判断

无辅助列的替代方案：正则表达式匹配 #

如果不想用Dictionary，可以直接利用正则表达式精确匹配分割后的子串，生成筛选条件数组：

Sub AutoFilter_Regex_Match()
    Const filter_Column As Long = 2
    Const filter_Delimiter As String = " "
    
    Dim filter_Criteria() As Variant
    filter_Criteria = Array("Cathodic Protection", "C.P", "Riser")
    
    Dim ws As Worksheet: Set ws = ActiveSheet
    Dim rg As Range
    Set rg = ws.UsedRange.Offset(1).Resize(ws.UsedRange.Rows.Count - 1)
    If rg.Rows.Count = 0 Then Exit Sub
    
    Dim arr() As Variant: arr = rg.Columns(filter_Column).Value
    Dim regex As Object: Set regex = CreateObject("VBScript.RegExp")
    regex.Global = False
    regex.IgnoreCase = False ' 区分大小写，如需忽略改为True
    
    ' 构建正则模式：匹配以分隔符开头/结尾，或完全匹配的子串
    Dim pattern As String
    pattern = "(^|\s)" & Join(filter_Criteria, "(\s|$)|(^|\s)") & "(\s|$)"
    regex.pattern = pattern
    
    Dim matchList As Collection: Set matchList = New Collection
    Dim r As Long, cellValue As String
    
    For r = 1 To UBound(arr, 1)
        cellValue = CStr(arr(r, 1))
        If Len(cellValue) > 0 Then
            If regex.Test(cellValue) Then
                On Error Resume Next ' 避免重复添加
                matchList.Add cellValue, Key:=cellValue
                On Error GoTo 0
            End If
        End If
    Next r
    
    If matchList.Count > 0 Then
        ' 将Collection转换为数组作为筛选条件
        Dim criteriaArr() As Variant
        ReDim criteriaArr(1 To matchList.Count)
        For r = 1 To matchList.Count
            criteriaArr(r) = matchList(r)
        Next r
        rg.AutoFilter Field:=filter_Column, Criteria1:=criteriaArr, Operator:=xlFilterValues
    Else
        rg.AutoFilter Field:=filter_Column
    End If
End Sub

方案说明 #

• 正则表达式模式确保匹配的是完整子串（而非部分包含），比如不会把"RiserX"误判为匹配"Riser"
• 利用Collection去重，最终生成筛选条件数组
• 无需Dictionary，直接通过正则匹配完成筛选逻辑

内容的提问来源于stack exchange，提问作者Peace