修改VBA代码实现遍历Sheet1 A列并跨表匹配返回F列值

我来帮你搞定这个问题！你的原代码只针对单个单元格的值做了搜索，所以只能处理第一行数据。下面是修改后的代码，完全实现你要的功能：遍历Sheet1的A列所有非空值，在工作簿其他工作表的A列查找精确匹配项，找到后把对应行的F列值返回（我默认输出到Sheet1的B列，你可以根据需要调整）。

Sub Return_Results_Entire_Workbook()
    Dim searchWs As Worksheet
    Dim outputWs As Worksheet
    Dim otherWs As Worksheet
    Dim searchCell As Range
    Dim lastSearchRow As Long
    Dim foundRng As Range
    Dim firstFoundAddress As String
    Dim outputRow As Long
    
    ' 定义搜索值所在工作表（Sheet1）和输出结果的工作表（这里默认用Sheet1的B列输出）
    Set searchWs = ThisWorkbook.Worksheets("Sheet1")
    Set outputWs = ThisWorkbook.Worksheets("Sheet1") ' 可以改成其他工作表，比如"Sheet2"
    
    ' 清空输出列（这里是Sheet1的B列，可根据需求修改列号）
    outputWs.Range("B:B").ClearContents
    
    ' 获取Sheet1 A列最后一行非空行号
    lastSearchRow = searchWs.Cells(searchWs.Rows.Count, "A").End(xlUp).Row
    
    ' 遍历Sheet1 A列的每个非空单元格
    For Each searchCell In searchWs.Range("A1:A" & lastSearchRow)
        ' 跳过空单元格
        If Trim(searchCell.Value) <> "" Then
            outputRow = searchCell.Row ' 结果输出到当前搜索行的B列
            
            ' 遍历工作簿中除了搜索工作表之外的所有工作表
            For Each otherWs In ThisWorkbook.Worksheets
                If otherWs.Name <> searchWs.Name Then ' 跳过搜索工作表本身
                    ' 在当前工作表的A列查找匹配值
                    Set foundRng = otherWs.Cells.Find( _
                        What:=searchCell.Value, _
                        LookIn:=xlValues, _
                        LookAt:=xlWhole, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)
                    
                    ' 如果找到匹配项
                    If Not foundRng Is Nothing Then
                        firstFoundAddress = foundRng.Address ' 记录第一个匹配项的地址，避免无限循环
                        
                        Do
                            ' 将匹配行的F列值写入输出列（这里是B列，可修改Offset的列数）
                            ' 如果有多个匹配项，用换行分隔或者写入下方单元格，这里我用换行分隔
                            If outputWs.Cells(outputRow, "B").Value = "" Then
                                outputWs.Cells(outputRow, "B").Value = otherWs.Cells(foundRng.Row, "F").Value
                            Else
                                outputWs.Cells(outputRow, "B").Value = outputWs.Cells(outputRow, "B").Value & vbNewLine & otherWs.Cells(foundRng.Row, "F").Value
                            End If
                            
                            ' 查找下一个匹配项
                            Set foundRng = otherWs.Cells.FindNext(foundRng)
                        Loop While Not foundRng Is Nothing And foundRng.Address <> firstFoundAddress
                    End If
                End If
            Next otherWs
        End If
    Next searchCell
    
    ' 自动调整输出列的行高，方便查看多结果
    outputWs.Columns("B").AutoFit
End Sub

关键改动说明： #

• 遍历Sheet1 A列：新增了For Each searchCell In searchWs.Range("A1:A" & lastSearchRow)循环，逐个处理A列的每个非空值
• 输出位置对应：把每个搜索值的结果输出到对应行的B列，这样结果和搜索值一一对应，更直观
• 避免无限循环：用firstFoundAddress记录第一个匹配项的地址，确保FindNext循环不会无限运行
• 处理多匹配项：如果同一个搜索值在多个工作表或同一工作表有多个匹配，用换行符把所有F列值合并在同一个单元格里（你也可以改成逐个写入下方单元格，只需调整输出行的逻辑）
• 代码可读性优化：用有意义的变量名（比如searchWs、otherWs），替换原代码中模糊的命名，同时添加了注释说明每个部分的作用

自定义调整建议： #

• 如果想把结果输出到其他工作表（比如Sheet2），只需修改Set outputWs = ThisWorkbook.Worksheets("Sheet2")，同时调整输出列的范围
• 如果不想合并多结果，而是每个结果占一行，可以把输出行的逻辑改成outputRow = outputWs.Cells(outputWs.Rows.Count, "B").End(xlUp).Row + 1
• 可以修改匹配方式（比如LookAt:=xlPart实现模糊匹配），根据你的需求调整Find方法的参数

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