如何用VBA实现单元格含指定词汇时返回对应代码？

核心思路 #

遍历目标列（A列）的每个有效单元格，同时检查预设的「词汇-代码」对照表，利用InStr函数判断单元格内容是否包含对照表中的词汇，找到第一个匹配项后，将对应代码写入同行B列。

完整VBA代码 #

Sub MatchWordToCode()
    Dim ws As Worksheet
    Dim lookupRange As Range ' 词汇-代码对照表范围，假设在Sheet2的A1:B10（可自行修改）
    Dim targetCell As Range
    Dim lookupRow As Range
    Dim matchFound As Boolean
    
    ' 设置目标数据所在工作表，根据实际情况修改名称
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    ' 设置对照表范围，假设词汇在Sheet2的A列，代码在B列，共10行
    Set lookupRange = ThisWorkbook.Worksheets("Sheet2").Range("A1:B10")
    
    ' 遍历A列所有有内容的单元格
    For Each targetCell In ws.Range("A1", ws.Cells(ws.Rows.Count, "A").End(xlUp))
        matchFound = False
        ' 遍历对照表的每一行
        For Each lookupRow In lookupRange.Rows
            ' 检查目标单元格是否包含当前词汇（vbTextCompare表示不区分大小写）
            If InStr(1, targetCell.Value, lookupRow.Cells(1, 1).Value, vbTextCompare) > 0 Then
                ' 将对应代码写入同行B列
                targetCell.Offset(0, 1).Value = lookupRow.Cells(1, 2).Value
                matchFound = True
                Exit For ' 找到第一个匹配后退出循环，如需匹配所有可删除此行
            End If
        Next lookupRow
        
        ' 未找到匹配时的处理，可自行修改默认值
        If Not matchFound Then
            targetCell.Offset(0, 1).Value = "" ' 也可改为"无匹配"
        End If
    Next targetCell
End Sub

代码说明 #

• 范围调整：根据实际文件修改ws（目标数据工作表）和lookupRange（词汇-代码对照表范围）的参数。
• 匹配规则：InStr函数实现包含匹配，保留vbTextCompare则不区分大小写，删除该参数则严格区分大小写。
• 多匹配处理：当前代码找到第一个匹配项即停止，若需返回所有匹配代码（用分隔符拼接），可删除Exit For并添加代码拼接逻辑。
• 无匹配处理：可根据需求修改未找到匹配时B列的显示内容。

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