工作表遍历区域匹配字符串并更新指定区域的VBA实现问题

先结合你的示例数据和预期输出，核心需求是：遍历B1:B4的每个单元格，检查该单元格内容是否是A1:A4中某单元格的子字符串，找到匹配的A行后，将B的内容填入对应行的C列。

示例数据 #

预期输出 #

方法一：Excel公式实现 #

不需要VBA的话，用数组公式（或Excel 365动态数组公式）就能解决：

在C1单元格输入以下公式，然后下拉填充到C4：

=TEXTJOIN("",TRUE,IF(ISNUMBER(SEARCH(B$1:B$4,A1)),B$1:B$4,""))

注意：旧版Excel输入后需按 Ctrl+Shift+Enter 确认数组公式；Excel 365/2021直接回车即可。

公式逻辑 #

• SEARCH(B$1:B$4,A1)：检查B列每个单元格内容是否在A1中出现，返回匹配位置或错误值
• ISNUMBER(...)：将匹配位置转换为TRUE（找到）或FALSE（未找到）
• IF(...)：找到匹配则返回对应B列内容，否则返回空值
• TEXTJOIN：拼接所有匹配结果（你的需求中每个A单元格只会匹配一个B值，最终就是单个结果）

方法二：修正后的VBA代码 #

你之前的VBA存在循环顺序错误、语法错误等问题，下面是修正后的可运行代码：

Option Explicit

Sub FindAndFillMatch()
    Dim ws As Worksheet
    Dim rngA As Range, rngB As Range
    Dim cellA As Range, cellB As Range
    
    ' 指定目标工作表
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Set rngA = ws.Range("A1:A4")
    Set rngB = ws.Range("B1:B4")
    
    ' 先清空C列目标区域，避免残留旧数据
    ws.Range("C1:C4").ClearContents
    
    ' 遍历B列每个单元格，检查是否存在于A列的某个单元格中
    For Each cellB In rngB
        For Each cellA In rngA
            ' 检查cellB内容是否是cellA的子字符串，vbTextCompare表示不区分大小写
            If InStr(1, cellA.Value, cellB.Value, vbTextCompare) > 0 Then
                ' 找到匹配，将B值填入对应A行的C列
                ws.Cells(cellA.Row, "C").Value = cellB.Value
                ' 每个B值仅匹配一次，找到后退出A列循环提升效率
                Exit For
            End If
        Next cellA
    Next cellB
End Sub

代码说明 #

1. 变量规范：明确指定工作表和区域，避免全局范围的歧义
2. 清空C列：先清除原有内容，防止旧数据干扰结果
3. 循环逻辑：先遍历B列每个值，再检查A列是否包含该值，符合需求逻辑
4. 匹配判断：用InStr函数检查子字符串，支持大小写控制
5. 高效退出：找到匹配后立即退出A列循环，减少不必要的遍历

你之前代码的问题分析 #

• 循环嵌套顺序错误：把C列循环放在最外层，完全颠倒了需求逻辑
• Like语法错误：正确写法应为 cellA Like "*" & cell2.Value & "*"，而非你写的cell1 Like *'cell2'*
• 赋值语句错误：cell1 In rng3 = cell2 In rng3 是无效的VBA语法，需直接指定单元格赋值
• 变量大小写不一致：Cell3 和 cell3 被当作不同变量，会导致编译错误

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