VBA跨工作簿数据获取代码故障求助：多次调试仍无法运行

原代码的核心问题 #

• 路径拼接错误：targetFilePath & "\\" & targetFileName 生成的路径包含双反斜杠，导致系统无法识别目标文件
• 工作表引用模糊：未明确指定Worksheets("Sheet1")属于哪个工作簿，可能误指向打开的目标工作簿，引发写入错误
• 无错误处理机制：无法定位具体故障（如文件不存在、工作表名称错误、VLOOKUP匹配失败等）
• VLOOKUP冗余调用：同一查找值重复调用VLOOKUP，降低运行效率

修正后的代码 #

Sub RetrieveData()
    Dim i As Long
    Dim targetWorkbook As Workbook
    Dim targetWorksheet As Worksheet
    Dim targetFilePath As String
    Dim targetFileName As String
    Dim currentWB As Workbook
    Dim currentWS As Worksheet
    Dim lookupValue As Variant
    Dim lookupResult As Variant
    
    ' 指定运行宏的当前工作簿和工作表
    Set currentWB = ThisWorkbook
    Set currentWS = currentWB.Worksheets("Sheet1") ' 按需修改实际表名
    
    ' 设置目标文件路径与名称
    targetFilePath = "\\kcjmserver\E\Data\Overseas Projects\Honilac Nutrition Limited\2023\Amazon reconciliation\D05 May 2023\Vlookup"
    targetFileName = "InventoryItems-20230605.xlsx"
    
    ' 捕获文件打开失败错误
    On Error Resume Next
    Set targetWorkbook = Workbooks.Open(targetFilePath & "\" & targetFileName)
    If Err.Number <> 0 Then
        MsgBox "无法打开目标文件：" & Err.Description, vbCritical
        Exit Sub
    End If
    On Error GoTo 0
    
    ' 验证目标工作表是否存在
    On Error Resume Next
    Set targetWorksheet = targetWorkbook.Worksheets("Sheet1") ' 按需修改实际表名
    If Err.Number <> 0 Then
        MsgBox "目标工作簿中不存在指定工作表", vbCritical
        targetWorkbook.Close SaveChanges:=False
        Exit Sub
    End If
    On Error GoTo 0
    
    ' 循环处理数据，优化查找逻辑
    For i = 2 To 26
        lookupValue = currentWS.Cells(i, 6).Value
        If Not IsEmpty(lookupValue) Then
            ' 获取第9列数据，处理匹配失败情况
            lookupResult = Application.VLookup(lookupValue, targetWorksheet.Range("A:M"), 9, False)
            currentWS.Cells(i, 10).Value = IIf(IsError(lookupResult), "", lookupResult)
            
            ' 获取第3列数据，处理匹配失败情况
            lookupResult = Application.VLookup(lookupValue, targetWorksheet.Range("A:M"), 3, False)
            currentWS.Cells(i, 7).Value = IIf(IsError(lookupResult), "", lookupResult)
        Else
            ' 空查找值时清空对应单元格
            currentWS.Cells(i, 10).Value = ""
            currentWS.Cells(i, 7).Value = ""
        End If
    Next i
    
    ' 关闭目标工作簿
    targetWorkbook.Close SaveChanges:=False
    
    ' 释放对象内存
    Set targetWorksheet = Nothing
    Set targetWorkbook = Nothing
    Set currentWS = Nothing
    Set currentWB = Nothing
    
    MsgBox "数据获取完成", vbInformation
End Sub

关键修正说明 #

1. 明确对象归属：用ThisWorkbook锁定运行宏的工作簿，彻底避免工作表引用混淆
2. 规范路径拼接：将双反斜杠改为单反斜杠，也可使用CreateObject("Scripting.FileSystemObject").BuildPath(targetFilePath, targetFileName)自动适配路径分隔符，兼容性更强
3. 错误预警机制：针对文件打开、工作表存在性添加错误捕获，直接给出故障原因
4. 优化查找逻辑：
   • 先判断查找值是否为空，跳过无效查找
   • 用IsError处理VLOOKUP匹配失败场景，避免单元格显示#N/A
   • 提取查找值到变量，减少重复单元格引用，提升运行效率
5. 内存管理：明确释放所有对象变量，避免内存泄漏

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