Excel单元格多词输入匹配数据库关键词的VBA代码优化需求

原代码仅支持精确匹配单个关键词，无法处理多关键词输入，也不支持"包含任一关键词即返回"的模糊匹配逻辑。以下是修改后的完整代码及关键说明：

修改后的VBA代码 #

Sub MultiKeywordSearch()
    Dim keywordArr As Variant
    Dim keyword As Variant
    Dim lastRow As Long
    Dim i As Long
    Dim outputRow As Long
    Dim isMatched As Boolean
    
    ' 清空结果区域
    Sheets("Search").Range("B5:B20").ClearContents
    
    ' 获取搜索关键词并拆分为数组（按空格分隔，可按需改成逗号等）
    keywordArr = Split(Trim(Sheets("Search").Range("B2").Value), " ")
    
    ' 获取数据库最后一行（更稳健的写法）
    lastRow = Sheets("Database").Cells(Rows.Count, 2).End(xlUp).Row
    
    ' 初始化结果输出起始行
    outputRow = 5 ' 结果从B5开始写入
    
    ' 遍历数据库每一行
    For i = 2 To lastRow
        isMatched = False
        ' 逐个检查关键词
        For Each keyword In keywordArr
            ' 判断单元格是否包含当前关键词（不区分大小写）
            If InStr(1, Sheets("Database").Cells(i, 2).Value, keyword, vbTextCompare) > 0 Then
                isMatched = True
                Exit For ' 匹配到任一关键词就停止检查当前行
            End If
        Next keyword
        
        ' 匹配成功则写入结果
        If isMatched Then
            Sheets("Search").Cells(outputRow, 2).Value = Sheets("Database").Cells(i, 2).Value
            outputRow = outputRow + 1
            ' 超过B20区域就停止输出
            If outputRow > 20 Then Exit For
        End If
    Next i
End Sub

关键修改说明 #

• 多关键词拆分：用Split函数把输入框的内容按空格拆分成关键词数组，若需要用逗号分隔，把代码中的" "改成", "即可。
• 模糊匹配逻辑：用InStr函数替代原有的精确相等判断，只要单元格内容包含任一关键词即判定匹配；vbTextCompare参数实现不区分大小写的匹配。
• 代码效率优化：去掉不必要的Activate切换操作，直接通过工作表对象引用单元格；用直接赋值代替Copy/Paste，减少运行时的屏幕闪烁。
• 结果边界控制：限制结果输出在B5-B20范围内，避免超出指定区域。

使用方式 #

在搜索单元格（Search表B2）中输入多个关键词，用空格（或你设置的分隔符）分隔即可，比如输入苹果 香蕉，会返回所有包含苹果或香蕉的数据库行。

内容的提问来源于stack exchange，提问作者Amira Mohamed Abdelsalam