Excel VBA使用InStr按工作表范围条件匹配内容并偏移输出实现咨询

实现方案 #

前置准备 #

新建一个名为关键词表的工作表，在该表A列按行录入所有需要匹配的关键词（如Jogging、Running、Jumping等），无需添加表头。

实现代码 #

Sub 关键词匹配输出()
    Dim 主表 As Worksheet, 关键词表 As Worksheet
    Dim 关键词数组 As Variant
    Dim 最后行 As Long, i As Long, j As Long
    Dim 匹配结果 As String
    
    ' 定义工作表，主表为存储待匹配内容的工作表，可按需修改为Sheets("你的表名")
    Set 主表 = ActiveSheet
    Set 关键词表 = ThisWorkbook.Sheets("关键词表")
    
    ' 一次性读取所有关键词到数组，提升运行效率
    关键词数组 = 关键词表.Range("A1", 关键词表.Cells(Rows.Count, "A").End(xlUp)).Value
    
    ' 获取主表A列最后一行有内容的行号
    最后行 = 主表.Cells(Rows.Count, "A").End(xlUp).Row
    
    ' 遍历主表所有待匹配行
    For i = 1 To 最后行
        匹配结果 = ""
        ' 遍历所有关键词匹配
        For j = 1 To UBound(关键词数组)
            ' vbTextCompare表示不区分大小写，需区分大小写可替换为vbBinaryCompare
            If InStr(1, 主表.Range("A" & i).Value, 关键词数组(j, 1), vbTextCompare) > 0 Then
                ' 多个匹配结果用顿号分隔，仅需保留第一个匹配结果可在本行后添加Exit For
                匹配结果 = 匹配结果 & 关键词数组(j, 1) & "、"
            End If
        Next j
        ' 处理结果并输出到同行B列
        If 匹配结果 <> "" Then
            主表.Range("B" & i).Value = Left(匹配结果, Len(匹配结果) - 1)
        Else
            ' 无匹配时B列留空，可按需修改为固定提示如"无匹配"
            主表.Range("B" & i).Value = ""
        End If
    Next i
End Sub

常用调整说明 #

• 关键词如果不需要单独存表，可直接修改关键词读取范围，比如存在当前表D列D1到D10，可将关键词读取代码改为关键词数组 = 主表.Range("D1:D10").Value
• 输出位置可自定义，比如要输出到同行F列，只需修改主表.Range("B" & i)为主表.Range("F" & i)
• 仅需匹配第一个关键词时，在匹配成功的If逻辑中添加Exit For即可跳出关键词循环，提升运行速度

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