VBA跨工作簿执行VLOOKUP取值报错调试及优化方案求助

原代码核心错误点 #

• 目标工作簿指向错误：Set twb = ThisWorkbook 指向的是存放代码的工具文件（Tool_SO.XLSM），但实际需要写入值的是主过程中打开的第一个待处理Excel文件，子过程未获取到该工作簿对象，无法找到对应工作表完成写入。
• 变量作用域问题：File2在主过程定义后没有传递给vlookup子过程，子过程内未声明该变量，属于隐式声明，容易触发变量未定义错误。
• 缺少错误兼容：VLOOKUP匹配不到值时会直接抛出运行时错误，无兜底处理逻辑。
• 硬编码风险：固定取数据源前1000行，数据量超过1000时会出现漏匹配。

修正后的实现代码 #

主过程调整（增加参数传递） #

Sub Past_dues_button12345()
    'Macro to create past due list daily
    Dim wb1 As Excel.Workbook
    Dim File As String
    Dim File2 As String

    File = Sheets("Tool").Range("B2")
    File2 = Sheets("Tool").Range("B3")

    Set wb1 = Workbooks.Open(File)

    remove_repair
    add_columns_with_comments
    add_data_new_column
    ' 传递待处理工作簿、数据源文件路径给vlookup子过程
    Call vlookup(wb1, File2)
    pastevalues
    Sharewb

End Sub

VLOOKUP子过程重写（批量公式方案，效率更高） #

Sub vlookup(targetWb As Workbook, sourceFilePath As String)
    Dim extwbk As Workbook
    Dim sourceRangeAddr As String
    Dim targetLastRow As Long
    Dim targetSht As Worksheet
    
    ' 打开数据源获取范围地址后直接关闭，无需保持后台打开
    Set extwbk = Workbooks.Open(sourceFilePath)
    sourceRangeAddr = extwbk.Worksheets("Material Availability").UsedRange.Address(External:=True)
    extwbk.Close SaveChanges:=False
    
    ' 定位待处理文件的目标工作表
    Set targetSht = targetWb.Sheets("Material Availability")
    targetLastRow = targetSht.Cells(targetSht.Rows.Count, 1).End(xlUp).Row
    
    ' 批量写入公式，效率远高于逐行循环
    With targetSht.Range("B2:B" & targetLastRow)
        .Formula = "=IFERROR(VLOOKUP(A2," & sourceRangeAddr & ",8,FALSE),"""")"
        ' 不需要保留公式可直接转值，无需额外调用pastevalues
        '.Value = .Value
    End With
End Sub

可选优化：add_columns_with_comments过程去除Select操作 #

Sub add_columns_with_comments()
    ' 建议替换原过程，避免选中操作带来的不可控错误
    With ActiveSheet ' 可替换为targetWb的指定工作表，稳定性更高
        .Columns("F:F").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
        .Columns("F:F").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
        .Columns("F:F").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
        .Range("Table1[[#Headers],[Column3]]") = "PN"
        .Range("Table1[[#Headers],[Column2]]") = "MRPc"
        .Range("Table1[[#Headers],[Column1]]") = "Comment"
    End With
End Sub

优化说明 #

• 取消逐行循环写入，改用批量公式方案，万行级数据处理速度提升10倍以上
• 新增IFERROR逻辑，匹配失败自动返回空值，不会触发运行时错误
• 自动识别数据源实际使用范围，不存在硬编码行数导致的漏匹配问题
• 全程无需激活工作簿、选中单元格，避免界面切换带来的未知错误

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