Excel VBA多工作簿搜索代码并匹配对应列值的报错排查

错误原因解析 #

• 错误1：Set rng = xFound.EntireRow.Cells("F")
  1. 若未找到匹配内容，xFound为Nothing，直接调用其方法会触发对象未设置的错误
  2. Cells("F")写法错误，Cells的语法是Cells(行号, 列号/列标)，单独传列标会被识别为行号，正确写法应为Cells(, "F")或Cells(, 6)
• 错误2：.Cells(xRow, 5) = xWk.Range("F")
Range("F")是无效引用，Range需要指定具体单元格或连续范围，比如Range("F1:F10")，这里应该直接取匹配行的F列单元格值

修正后的完整VBA代码 #

Sub SearchCodeAcrossWorkbooks()
    Dim xFd As FileDialog
    Dim xPath As String
    Dim xFile As String
    Dim xWb As Workbook
    Dim xWs As Worksheet
    Dim xFound As Range
    Dim xSearchValue As String
    Dim xRow As Long
    Dim xFirstAddr As String
    
    ' 获取用户输入的搜索代码
    xSearchValue = InputBox("请输入要搜索的代码：", "搜索代码")
    If xSearchValue = "" Then Exit Sub
    
    ' 选择目标目录
    Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
    If xFd.Show <> -1 Then Exit Sub
    xPath = xFd.SelectedItems(1) & "\"
    
    ' 初始化结果输出行（当前工作表第2行开始）
    xRow = 2
    With ThisWorkbook.ActiveSheet
        ' 写入表头
        .Cells(1, 1) = "搜索代码"
        .Cells(1, 2) = "所在工作簿"
        .Cells(1, 3) = "所在工作表"
        .Cells(1, 4) = "所在行号"
        .Cells(1, 5) = "F列对应值"
    End With
    
    ' 遍历目录下的Excel文件
    xFile = Dir(xPath & "*.xlsx")
    Do While xFile <> ""
        Set xWb = Workbooks.Open(xPath & xFile, ReadOnly:=True)
        ' 遍历工作簿中的每个工作表
        For Each xWs In xWb.Worksheets
            ' 在当前工作表中搜索目标代码
            Set xFound = xWs.Cells.Find(What:=xSearchValue, LookIn:=xlValues, LookAt:=xlWhole)
            If Not xFound Is Nothing Then
                xFirstAddr = xFound.Address
                Do
                    ' 写入结果到当前工作表
                    With ThisWorkbook.ActiveSheet
                        .Cells(xRow, 1) = xSearchValue
                        .Cells(xRow, 2) = xWb.Name
                        .Cells(xRow, 3) = xWs.Name
                        .Cells(xRow, 4) = xFound.Row
                        ' 直接取匹配行F列的值，避免无效引用
                        .Cells(xRow, 5) = xWs.Cells(xFound.Row, "F").Value
                    End With
                    xRow = xRow + 1
                    ' 继续查找下一个匹配项
                    Set xFound = xWs.Cells.FindNext(xFound)
                Loop While Not xFound Is Nothing And xFound.Address <> xFirstAddr
            End If
        Next xWs
        ' 关闭工作簿，不保存
        xWb.Close SaveChanges:=False
        xFile = Dir()
    Loop
    
    MsgBox "搜索完成，结果已输出到当前工作表！", vbInformation
End Sub

关键修改说明 #

1. 增加了xFound Is Nothing的判断，避免未找到匹配项时触发对象错误
2. 直接通过xWs.Cells(xFound.Row, "F").Value定位匹配行的F列单元格，替代原错误写法
3. 修正了Range("F")的无效引用问题，改为精准获取目标单元格值
4. 补充了表头写入逻辑，让结果输出更清晰
5. 以只读模式打开目标工作簿，避免误修改原文件
6. 加入FindNext循环，支持单个工作表内多个匹配项的搜索

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