如何修改VBA代码实现两列数据的Autofilter部分匹配？

需求说明 #

• 需实现两列数据的部分匹配筛选：
  • 列1（对应原代码Field=4，公式中G列）：匹配包含Mws.Range("E5")值的内容，该值可为数字+字符或纯字符（如YT-154895、buffer）
  • 列2（对应原代码Field=5，公式中H列）：匹配包含Mws.Range("G5")值的内容，该值为纯数字（如4501236852）
• 原Autofilter代码单列可行，但两列组合失效；已有可正常运行的Excel公式，需转换为VBA代码

原Excel公式 #

=IFS(I9="Partial Match",FILTER('Project Record'!D3:AX99999,ISNUMBER(SEARCH(E5,'Project Record'!G3:G99999))*ISNUMBER(SEARCH(G5,'Project Record'!H3:H99999)),"No Match Found"))

解决方案1：直接复用FILTER公式逻辑的VBA代码 #

此方案完全匹配原公式的筛选逻辑，避免Autofilter对数字列部分匹配的限制，稳定性更高：

Sub Search()
    Dim Mws As Worksheet
    Dim PR As Worksheet
    Dim searchText1 As String, searchText2 As String
    Dim resultRange As Variant
    
    Set Mws = ThisWorkbook.Sheets("Data input v2")
    Set PR = ThisWorkbook.Sheets("Project Record")
    
    ' 清空目标输出区域
    Mws.Range("C19:AW9999").ClearContents
    
    ' 获取两个搜索关键词
    searchText1 = Mws.Range("E5").Value
    searchText2 = Mws.Range("G5").Value
    
    ' 仅当I9为"Partial Match"时执行筛选
    If Mws.Range("I9").Value = "Partial Match" Then
        ' 捕获无匹配结果的错误
        On Error Resume Next
        ' 调用Excel原生FILTER函数，复用原公式的匹配逻辑
        resultRange = Application.Filter( _
            PR.Range("D3:AX99999"), _
            Application.IsNumber(Application.Search(searchText1, PR.Range("G3:G99999"))) * _
            Application.IsNumber(Application.Search(searchText2, PR.Range("H3:H99999"))), _
            "No Match Found" _
        )
        On Error GoTo 0
        
        ' 将结果写入目标区域
        If Not IsError(resultRange) Then
            Mws.Range("C19").Resize(UBound(resultRange, 1), UBound(resultRange, 2)).Value = resultRange
        Else
            Mws.Range("C19").Value = "No Match Found"
        End If
    End If
End Sub

解决方案2：修复Autofilter的多列匹配代码 #

若坚持使用Autofilter，需处理数字列的匹配问题（Autofilter通配符仅对文本格式生效）：

Sub SearchWithAutofilter()
    Dim Mws As Worksheet
    Dim PR As Worksheet
    Dim Rng As Range
    Dim searchText1 As String, searchText2 As String
    
    Set Mws = ThisWorkbook.Sheets("Data input v2")
    Set PR = ThisWorkbook.Sheets("Project Record")
    
    Mws.Range("C19:AW9999").ClearContents
    searchText1 = Mws.Range("E5").Value
    searchText2 = Mws.Range("G5").Value
    
    ' 定义筛选数据范围（包含表头）
    Set Rng = PR.Range("D2:AX" & PR.Cells(PR.Rows.Count, "AX").End(xlUp).Row)
    
    ' 关闭已有筛选
    PR.AutoFilterMode = False
    
    With Rng
        ' 第一列（Field=4）：通配符部分匹配
        .AutoFilter Field:=4, Criteria1:="*" & searchText1 & "*"
        ' 第二列（Field=5）：用自定义文本匹配规则，适配数字列
        .AutoFilter Field:=5, Criteria1:="=*" & searchText2 & "*"
    End With
    
    ' 复制可见行数据（跳过表头）
    On Error Resume Next
    Rng.Offset(1).Resize(Rng.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy Mws.Range("C19")
    On Error GoTo 0
    
    ' 关闭筛选
    PR.AutoFilterMode = False
End Sub

注意事项 #

• 解决方案2中，若H列（Field=5）为纯数字格式，需确保Excel将其识别为文本进行匹配，否则可能失效；若数据格式不确定，优先选择解决方案1
• 两种方案均保留了原公式中I9="Partial Match"的触发条件

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