Excel跨行列查找求助：求可用公式或修复现有VBA代码

一、Excel公式实现（优先推荐） #

适用于Excel 365/2021（支持LAMBDA函数） #

在Tool工作表的B2单元格输入以下公式，然后下拉填充至所有需要匹配的行：

=TEXTJOIN(", ", TRUE, FILTER('Tool Backsheet'!$A:$A, BYROW('Tool Backsheet'!$B:$F, LAMBDA(r, COUNTIF(r, A2)>0))))

公式说明：

• BYROW('Tool Backsheet'!$B:$F, LAMBDA(r, COUNTIF(r, A2)>0))：遍历Tool Backsheet的每一行B-F列，检查当前行是否包含A2的缩写
• FILTER('Tool Backsheet'!$A:$A, ...)：筛选出符合条件的行对应的A列值
• TEXTJOIN(", ", TRUE, ...)：用「逗号+空格」将所有匹配结果连接成字符串，自动忽略空白值

适用于旧版Excel（无LAMBDA） #

使用数组公式（输入完成后按Ctrl+Shift+Enter确认生效），注意替换公式中的行号范围为你的实际数据范围：

=TEXTJOIN(", ", TRUE, IF(MMULT(--('Tool Backsheet'!$B$2:$F$1000=A2), ROW($1:$5)^0)>0, 'Tool Backsheet'!$A$2:$A$1000, ""))

公式说明：

• --('Tool Backsheet'!$B$2:$F$1000=A2)：将匹配结果转换为0/1的布尔数组
• MMULT(..., ROW($1:$5)^0)：计算每一行的匹配次数，大于0则说明该行包含目标缩写
• TEXTJOIN将所有符合条件的A列值连接为字符串

二、修复后的VBA代码 #

原代码存在三个核心问题：仅检查Tool Backsheet第1行的B-F列、找到第一个匹配就终止循环、未处理多行结果的聚合需求。修复后的代码如下：

Sub LookupAndIndexMatch()
    Dim wsTool As Worksheet
    Dim wsToolBacksheet As Worksheet
    Dim lastRowTool As Long
    Dim lastRowToolBacksheet As Long
    Dim i As Long, rowBack As Long
    Dim lookupValue As String
    Dim result As String
    
    Set wsTool = ThisWorkbook.Sheets("Tool")
    Set wsToolBacksheet = ThisWorkbook.Sheets("Tool Backsheet")
    
    lastRowTool = wsTool.Cells(wsTool.Rows.Count, "A").End(xlUp).Row
    lastRowToolBacksheet = wsToolBacksheet.Cells(wsToolBacksheet.Rows.Count, "A").End(xlUp).Row
    
    '清空B列原有数据
    wsTool.Range("B2:B" & lastRowTool).ClearContents
    
    For i = 2 To lastRowTool
        lookupValue = wsTool.Cells(i, "A").Value
        result = ""
        
        If lookupValue <> "" Then
            '遍历Tool Backsheet的所有数据行（假设第1行是表头）
            For rowBack = 2 To lastRowToolBacksheet
                '检查当前行B-F列是否存在完全匹配的缩写
                If Not wsToolBacksheet.Rows(rowBack).Range("B:F").Find(lookupValue, LookIn:=xlValues, LookAt:=xlWhole) Is Nothing Then
                    If result <> "" Then
                        result = result & ", "
                    End If
                    result = result & wsToolBacksheet.Cells(rowBack, "A").Value
                End If
            Next rowBack
        End If
        
        wsTool.Cells(i, "B").Value = result
    Next i
End Sub

修改说明：

• 修正数据行范围的获取逻辑，确保覆盖所有有效数据
• 遍历Tool Backsheet的每一行，检查B-F列是否包含目标缩写
• 收集所有匹配结果，用逗号分隔后写入对应单元格
• 增加空值判断，避免处理空白的缩写单元格

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