VBA中使用两个外部工作簿实现VLOOKUP时运行时错误9求助

问题描述 #

我正在创建一个宏，执行流程如下：

• 在工作表表头下方的顶部添加一行新行。
• 让用户选择两个用于后续引用的外部Excel文件。
• 使用第一个选中文件的VLOOKUP填充单个单元格。
• 使用第二个选中文件的VLOOKUP填充一个单元格区域。

注意：所有通过VLOOKUP填充的单元格都位于步骤1中新创建的行上。

目前编写的代码只有注释掉其中一个VLOOKUP或其中一个调用的文件时才能正常运行。直接运行完整代码会出现运行时错误9：下标越界。

附上代码：

Sub PWGS_Import_P2_MerickID()
'This macro is to fill out the PWGS Tracker using VLOOKUP for the Merrick IDs from the Shipped and Incoming Meter files from Carte; It will ask for two files to be opened. 1st is Incoming, then Shipped


'Definitions
Dim PWGS As Workbook
Dim BlackSail_P2 As Worksheet
Dim BlackSail_P2_Incoming As Range
Dim BlackSail_P2_Shipped As Range


Set PWGS = ThisWorkbook
Set BlackSail_P2 = PWGS.Worksheets("Black Sail (Pipeline 2)")

'adding a new row
Sheets(Array("Black Sail (Pipeline 2)")).Select
Sheets("Black Sail (Pipeline 2)").Activate
Rows("5:5").Select
Selection.Copy
Selection.Insert Shift:=xlDown
Application.CutCopyMode = False
Rows("5:5").Select
Selection.ClearContents

'opening P2_Incoming file
Dim fNameAndPath As Variant, P2_Incoming As Workbook
fNameAndPath = Application.GetOpenFilename
If fNameAndPath = False Then Exit Sub
Set P2_Incoming = Workbooks.Open(fNameAndPath)

'opening P2_Shipped file
Dim fNameAndPath_2 As Variant, P2_Shipped As Workbook
fNameAndPath_2 = Application.GetOpenFilename
If fNameAndPath_2 = False Then Exit Sub
Set P2_Shipped = Workbooks.Open(fNameAndPath_2)

'LOOPS
With P2_Incoming
For Each BlackSail_P2_Incoming In Range("B5")
BlackSail_P2_Incoming.Value = _
Application.WorksheetFunction.VLookup(BlackSail_P2_Incoming.Offset(-2, 0), _
Sheets("PWGS Incoming Meters").Range("C:D"), 2, 0)
Next
End With


With P2_Shipped
For Each BlackSail_P2_Shipped In Range("F5:J5")

BlackSail_P2_Shipped.Value = _
Application.WorksheetFunction.VLookup(BlackSail_P2_Shipped.Offset(-2, 0), _
Sheets("PWGS Shipped Meters").Range("C:D"), 2, 0)
    
Next BlackSail_P2_Shipped
End With

End Sub

解决思路 #

出现下标越界错误的核心原因：

1. With P2_Incoming/With P2_Shipped块中，Range("B5")和Range("F5:J5")未指定所属工作表，默认指向当前激活的工作簿（即第二个打开的P2_Shipped文件），但实际需要操作的是PWGS工作簿的BlackSail_P2工作表。
2. Sheets("PWGS Incoming Meters")和Sheets("PWGS Shipped Meters")未指定所属工作簿，多工作簿打开时VBA无法确定引用对象，导致找不到对应工作表。

修正要点：

• 所有Range和Sheets对象必须明确指定所属工作簿和工作表，避免依赖激活状态。
• 移除不必要的Select/Activate操作，直接操作对象更稳定高效。
• 添加错误处理，避免VLOOKUP无匹配值时抛出错误。

修正后的代码 #

Sub PWGS_Import_P2_MerickID()
    ' 填充PWGS追踪表，从Carte的发货和入库仪表文件中通过VLOOKUP获取Merrick ID
    ' 先选择入库文件，再选择发货文件
    
    ' 定义变量
    Dim PWGS As Workbook
    Dim BlackSail_P2 As Worksheet
    Dim P2_Incoming As Workbook
    Dim P2_Shipped As Workbook
    Dim lookupValue As Variant
    Dim result As Variant
    
    Set PWGS = ThisWorkbook
    Set BlackSail_P2 = PWGS.Worksheets("Black Sail (Pipeline 2)")
    
    ' 在第5行插入新行（复制格式后清空内容）
    BlackSail_P2.Rows("5:5").Copy
    BlackSail_P2.Rows("5:5").Insert Shift:=xlDown
    Application.CutCopyMode = False
    BlackSail_P2.Rows("5:5").ClearContents
    
    ' 选择并打开入库文件
    Dim fNameAndPath As Variant
    fNameAndPath = Application.GetOpenFilename(FileFilter:="Excel文件 (*.xlsx;*.xls), *.xlsx;*.xls", Title:="选择入库仪表文件")
    If fNameAndPath = False Then Exit Sub
    Set P2_Incoming = Workbooks.Open(fNameAndPath)
    
    ' 选择并打开发货文件
    Dim fNameAndPath_2 As Variant
    fNameAndPath_2 = Application.GetOpenFilename(FileFilter:="Excel文件 (*.xlsx;*.xls), *.xlsx;*.xls", Title:="选择发货仪表文件")
    If fNameAndPath_2 = False Then
        P2_Incoming.Close SaveChanges:=False
        Exit Sub
    End If
    Set P2_Shipped = Workbooks.Open(fNameAndPath_2)
    
    ' 用入库文件VLOOKUP填充B5单元格
    lookupValue = BlackSail_P2.Range("B3").Value ' 对应原Offset(-2,0)的位置（新行是第5行，上移2行是第3行）
    On Error Resume Next ' 处理VLOOKUP找不到值的情况
    result = Application.WorksheetFunction.VLookup(lookupValue, P2_Incoming.Worksheets("PWGS Incoming Meters").Range("C:D"), 2, 0)
    On Error GoTo 0
    BlackSail_P2.Range("B5").Value = IIf(IsEmpty(result), "未找到匹配", result)
    
    ' 用发货文件VLOOKUP填充F5:J5区域
    Dim cell As Range
    For Each cell In BlackSail_P2.Range("F5:J5")
        lookupValue = cell.Offset(-2, 0).Value ' 上移2行取查找值
        On Error Resume Next
        result = Application.WorksheetFunction.VLookup(lookupValue, P2_Shipped.Worksheets("PWGS Shipped Meters").Range("C:D"), 2, 0)
        On Error GoTo 0
        cell.Value = IIf(IsEmpty(result), "未找到匹配", result)
    Next cell
    
    ' 关闭外部文件（按需选择是否保存）
    P2_Incoming.Close SaveChanges:=False
    P2_Shipped.Close SaveChanges:=False
End Sub

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