如何用VBA让Excel识别空格、无间隔字符与下划线等价？

我有一个简易表格，当在B5单元格中输入“abc_d”时，能正确筛选出对应的结果。现在希望在B5中输入“abc d”或者“abcd”时，Excel也能匹配到“abc_d”这条数据。目前使用的筛选VBA代码如下：

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim cell As Range
    With Sheet1
        .AutoFilterMode = False
        With .Range("A6:B6")
            .AutoFilter
            If Len(Range("A5").Value) <> 0 Then
                .AutoFilter Field:=1, Criteria1:="*" & Range("A5").Value & "*"
            End If
            If Len(Range("B5").Value) <> 0 Then
                .AutoFilter Field:=2, Criteria1:="*" & Range("B5").Value & "*"
            End If
        End With
        
    End With
    
End Sub

要实现这个模糊匹配需求，需要对B5的搜索文本做预处理，生成能兼容空格、下划线或无分隔的筛选条件。下面提供两种实现方式：

方式一：精准匹配指定场景 #

如果只需要针对“abc d”和“abcd”匹配“abc_d”，可以直接定制筛选条件：

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    With Sheet1
        .AutoFilterMode = False
        With .Range("A6:B6")
            .AutoFilter
            ' A列筛选逻辑保持不变
            If Len(.Parent.Range("A5").Value) <> 0 Then
                .AutoFilter Field:=1, Criteria1:="*" & .Parent.Range("A5").Value & "*"
            End If
            
            ' 处理B列的特殊匹配需求
            Dim searchTxt As String
            searchTxt = .Parent.Range("B5").Value
            If Len(searchTxt) <> 0 Then
                Dim criteria As String
                ' 判断输入内容，生成对应筛选规则
                If searchTxt = "abc d" Or searchTxt = "abcd" Then
                    criteria = "*abc[_ ]d*" ' 匹配abc后面跟下划线/空格，再跟d的内容
                Else
                    criteria = "*" & searchTxt & "*" ' 其他情况沿用原逻辑
                End If
                .AutoFilter Field:=2, Criteria1:=criteria
            End If
        End With
    End With
End Sub

方式二：通用匹配所有类似场景 #

如果需要支持任意文本的匹配（比如输入“xyz y”或“xyzy”能匹配“xyz_y”），可以用通用的字符间通配符处理：

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    With Sheet1
        .AutoFilterMode = False
        With .Range("A6:B6")
            .AutoFilter
            ' A列筛选逻辑不变
            If Len(.Parent.Range("A5").Value) <> 0 Then
                .AutoFilter Field:=1, Criteria1:="*" & .Parent.Range("A5").Value & "*"
            End If
            
            Dim searchTxt As String
            searchTxt = .Parent.Range("B5").Value
            If Len(searchTxt) > 0 Then
                ' 先移除输入中的空格，再给每个字符间添加允许下划线/空格的通配符
                searchTxt = Replace(searchTxt, " ", "")
                Dim criteria As String
                Dim i As Integer
                criteria = ""
                For i = 1 To Len(searchTxt)
                    criteria = criteria & Mid(searchTxt, i, 1)
                    ' 不是最后一个字符的话，允许中间出现0个或1个下划线/空格
                    If i < Len(searchTxt) Then
                        criteria = criteria & "[ _]?"
                    End If
                Next i
                criteria = "*" & criteria & "*"
                .AutoFilter Field:=2, Criteria1:=criteria
            End If
        End With
    End With
End Sub

说明 #

• 方式一适合只需要处理特定关键词的场景，逻辑简单直接
• 方式二更灵活，能自动适配所有类似的“空格/连写匹配下划线”需求，比如输入“test 123”或“test123”都能匹配“test_123”

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