如何修改VBA代码以实现多字符串搜索并高亮对应行？

原代码功能说明 #

原代码支持用户输入单个搜索字符串，在选中区域内查找包含该字符串的单元格，并选中对应的整行。

修改思路 #

要支持多字符串搜索，核心做以下调整：

• 允许用户输入多个用逗号分隔的搜索词（示例：苹果,香蕉,橙子）
• 将输入内容按逗号拆分为搜索词数组
• 遍历单元格时，检查是否包含数组中任意一个搜索词
• 避免重复选中同一行（比如某行同时包含多个搜索词时只选中一次）

修改后的完整代码 #

Sub MultiStringSearchAndHighlightRows()
    Dim Rng As Range
    Dim myCell As Range
    Dim myUnion As Range
    Dim searchInput As String
    Dim searchStrings() As String
    Dim i As Integer
    Dim isMatch As Boolean
    
    ' 设置搜索范围为选中区域
    Set Rng = Selection
    If Rng Is Nothing Then
        MsgBox "请先选中要搜索的区域！"
        Exit Sub
    End If
    
    ' 获取用户输入的多搜索词（用逗号分隔）
    searchInput = InputBox("请输入要搜索的多个关键词，用逗号分隔：" & vbCrLf & "示例：苹果,香蕉,橙子")
    If searchInput = "" Then
        MsgBox "未输入任何搜索关键词！"
        Exit Sub
    End If
    
    ' 将输入的字符串拆分为搜索词数组
    searchStrings = Split(Trim(searchInput), ",")
    
    ' 遍历选中区域的每个单元格
    For Each myCell In Rng
        isMatch = False
        ' 检查当前单元格是否包含任意一个搜索词
        For i = LBound(searchStrings) To UBound(searchStrings)
            ' 去除搜索词前后的空格，避免空格干扰
            If InStr(1, myCell.Text, Trim(searchStrings(i)), vbTextCompare) > 0 Then
                isMatch = True
                Exit For ' 找到匹配后跳出内层循环，提升效率
            End If
        Next i
        
        ' 如果匹配成功，将对应整行加入选中集合
        If isMatch Then
            If Not myUnion Is Nothing Then
                ' 检查当前行是否已经在集合中，避免重复添加
                If Intersect(myUnion, myCell.EntireRow) Is Nothing Then
                    Set myUnion = Union(myUnion, myCell.EntireRow)
                End If
            Else
                Set myUnion = myCell.EntireRow
            End If
        End If
    Next myCell
    
    ' 输出结果
    If myUnion Is Nothing Then
        MsgBox "在选中区域中未找到匹配的内容！"
    Else
        myUnion.Select
        MsgBox "已选中所有包含指定关键词的行，共 " & myUnion.Areas.Count & " 行"
    End If
End Sub

关键改动说明 #

• 多关键词处理：用Split函数将逗号分隔的输入内容拆分为数组，实现同时搜索多个词
• 不区分大小写搜索：使用vbTextCompare参数让InStr函数忽略大小写，若需要区分可改为vbBinaryCompare
• 避免重复选行：添加Intersect检查，确保同一行不会被重复加入选中集合
• 用户体验优化：增加未选区域、未输入关键词的提示，以及最终选中行数的反馈
• 代码规范优化：将myCell的类型从Object改为Range更精准，添加注释提升可读性

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