VBA多关键词过滤异常排查请求：3-4个关键词时返回0行数据

方案1：用高级筛选（AdvancedFilter）绕开限制 #

高级筛选支持复杂的多条件“或”逻辑，完全适配你的需求。下面是修改后的代码，会动态生成筛选条件并执行高级筛选：

Sub GenerateFilteredReport()
    Dim wsReport As Worksheet, wsData As Worksheet
    Dim keywordList As Collection
    Dim criteriaCell As Range
    Dim lastDataRow As Long, i As Integer
    
    '初始化工作表对象
    Set wsReport = ThisWorkbook.Sheets("Report generator")
    Set wsData = ThisWorkbook.Sheets("Data")
    Set keywordList = New Collection
    
    '收集非空的关键词（自动去重）
    On Error Resume Next
    For Each cell In wsReport.Range("C4:C7")
        If Trim(cell.Value) <> "" Then
            keywordList.Add "*" & Trim(cell.Value) & "*", Key:=Trim(cell.Value)
        End If
    Next cell
    On Error GoTo 0
    
    If keywordList.Count = 0 Then Exit Sub '没有关键词就退出
    
    '清除之前的筛选
    wsData.AutoFilterMode = False
    
    '在Data表的空白区域创建条件区域（用第5列的标题）
    wsData.Range("G1").Value = wsData.Cells(1, 5).Value
    Set criteriaCell = wsData.Range("G2")
    For i = 1 To keywordList.Count
        criteriaCell.Value = keywordList(i)
        Set criteriaCell = criteriaCell.Offset(1, 0)
    Next i
    
    '执行高级筛选（原地筛选）
    lastDataRow = wsData.Cells(wsData.Rows.Count, "A").End(xlUp).Row
    wsData.Range("A1:F" & lastDataRow).AdvancedFilter _
        Action:=xlFilterInPlace, _
        CriteriaRange:=wsData.Range("G1:G" & keywordList.Count + 1)
    
    '清理临时条件区域
    wsData.Range("G1:G" & keywordList.Count + 1).ClearContents
    
    '接下来执行你原来的复制到Word的逻辑...
End Sub

方案2：用辅助列标记匹配行 #

如果觉得高级筛选麻烦，也可以临时加个辅助列，用公式判断每行是否包含任一关键词，再筛选这个列：

Sub FilterWithHelperColumn()
    Dim wsReport As Worksheet, wsData As Worksheet
    Dim keywords() As String
    Dim lastDataRow As Long, kwCount As Integer, i As Integer
    Dim helperCol As Integer: helperCol = 7 '用G列当辅助列
    
    Set wsReport = ThisWorkbook.Sheets("Report generator")
    Set wsData = ThisWorkbook.Sheets("Data")
    
    '收集非空关键词
    kwCount = 0
    ReDim keywords(1 To 4)
    For Each cell In wsReport.Range("C4:C7")
        If Trim(cell.Value) <> "" Then
            kwCount = kwCount + 1
            keywords(kwCount) = "ISNUMBER(SEARCH(""" & Trim(cell.Value) & """,E2))"
        End If
    Next cell
    If kwCount = 0 Then Exit Sub
    ReDim Preserve keywords(1 To kwCount)
    
    '清除旧筛选和辅助列内容
    wsData.AutoFilterMode = False
    wsData.Columns(helperCol).ClearContents
    
    '写入辅助列标题和公式
    wsData.Cells(1, helperCol).Value = "IsMatch"
    wsData.Cells(2, helperCol).Formula = "=OR(" & Join(keywords, ",") & ")"
    lastDataRow = wsData.Cells(wsData.Rows.Count, "A").End(xlUp).Row
    wsData.Cells(2, helperCol).AutoFill Destination:=wsData.Cells(2, helperCol).Resize(lastDataRow - 1)
    
    '筛选匹配行
    wsData.Range("A1:F" & lastDataRow).AutoFilter Field:=helperCol, Criteria1:=True
    
    '复制到Word后，可以删除辅助列：wsData.Columns(helperCol).Delete
End Sub

这两种方法都能完美解决3-4个关键词的筛选问题，你可以根据自己的习惯选一个。高级筛选更“干净”，不需要修改原数据结构；辅助列方法则更直观，容易理解。

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