VBA运行时错误'9'下标越界：工作簿引用语句报错排查

报错语句直接原因 #

Workbooks(文件名)是通过文件名从当前Excel进程已打开的工作簿集合中匹配对象，触发下标越界说明集合中不存在匹配该名称的工作簿，不存在其他触发可能，常见诱因：

• 目标工作簿未打开：Workbooks集合不会自动读取磁盘上未打开的文件，代码中无打开目标文件的逻辑时直接引用必然报错
• 文件名不匹配：包括扩展名错误（实际为.xlsm/.xls而非.xlsx）、文件名存在隐藏后缀（Windows默认隐藏扩展名时易出现FileName.xlsx.xlsx类命名错误）、文件名拼写漏字/多空格
• 工作簿在独立Excel进程中打开：双击文件启动的新Excel窗口属于独立进程，跨进程打开的工作簿不会出现在运行宏的Excel实例的Workbooks集合中

报错语句修复方案 #

替换原有Set wkbRef = Excel.Workbooks("FileName.xlsx")段落为带容错的自动识别/打开逻辑，避免文件名匹配错误：

' 替换为目标文件的完整磁盘路径
Const TARGET_FILE_PATH As String = "C:\你的文件存储目录\FileName.xlsx"
Dim wkbRef As Excel.Workbook
On Error Resume Next
' 尝试匹配已打开的同名工作簿
Set wkbRef = Excel.Workbooks(Dir(TARGET_FILE_PATH))
If Err.Number <> 0 Then
    Err.Clear
    ' 未打开则直接从磁盘加载
    Set wkbRef = Excel.Workbooks.Open(TARGET_FILE_PATH)
    If Err.Number <> 0 Then
        MsgBox "目标文件路径无效或文件损坏，请检查：" & TARGET_FILE_PATH
        Exit Sub
    End If
End If
On Error GoTo 0

代码其余隐藏的下标越界/运行时错误点 #

修复上述语句后，代码中还有多处逻辑错误会触发同类报错，需一并修正：

• 变量名拼写不一致：定义的工作簿变量为wkbOpen，后续循环中误写为wbOpen，结果输出段落误写为wb，未定义的对象调用会触发错误
• 数组初始化逻辑错误：arr = Array()生成的空数组直接调用UBound(arr)会触发下标越界，首次写入数组需特殊判断
• 工作簿引用错误：定义了wkbRef作为外部数据工作簿，但循环读工作表时误引用了wkbOpen（当前宏所在工作簿），未读取目标外部文件数据
• 行范围生成语法错误：Evaluate("Row(" & (1 + i) & ":" & ")")缺少范围结束值，需补全为12 + i匹配连续12个工作表的取值范围
• 工作簿关闭逻辑错误：提前关闭wkbOpen（宏所在工作簿）后再执行单元格写入操作，会触发对象不存在错误

修正后完整可运行代码 #

Sub LoopValues()
    Application.ScreenUpdating = False
    
    ' 配置项 - 修改为你的实际文件路径
    Const TARGET_FILE_PATH As String = "C:\你的文件存储目录\FileName.xlsx"
    Const OUTPUT_SHEET As String = "Sheet1"
    Const READ_CELL As String = "AA208"
    Const START_OUTPUT_ROW As Long = 99
    Const GROUP_SIZE As Integer = 12
    Const START_SHEET_DATE As Date = #2/1/2020# ' 对应第一个工作表名2002
    
    Dim i As Long, counter As Long
    Dim wkbRef As Workbook, wkbCurrent As Workbook
    Dim ws As Worksheet
    Dim WsName As String
    Dim wsExists As Boolean
    Dim arr() As Variant
    Dim arrIndex As Long
    
    ' 初始化数组
    arrIndex = -1
    
    ' 绑定工作簿
    Set wkbCurrent = ThisWorkbook ' 宏所在工作簿，避免ActiveWorkbook焦点偏移错误
    On Error Resume Next
    Set wkbRef = Workbooks(Dir(TARGET_FILE_PATH))
    If Err.Number <> 0 Then
        Err.Clear
        Set wkbRef = Workbooks.Open(TARGET_FILE_PATH)
        If Err.Number <> 0 Then
            MsgBox "目标文件打开失败，请检查路径：" & TARGET_FILE_PATH
            Application.ScreenUpdating = True
            Exit Sub
        End If
    End If
    On Error GoTo 0
    
    ' 循环读取所有符合命名规则的工作表值
    wsExists = True
    counter = 0
    Do While wsExists
        WsName = Format(DateAdd("m", counter, START_SHEET_DATE), "mmyy")
        On Error Resume Next
        Set ws = wkbRef.Sheets(WsName)
        If Err.Number <> 0 Then
            wsExists = False
            Err.Clear
        Else
            arrIndex = arrIndex + 1
            ReDim Preserve arr(0 To arrIndex)
            arr(arrIndex) = ws.Range(READ_CELL).Value
        End If
        On Error GoTo 0
        counter = counter + 1
    Loop
    
    ' 校验数组长度足够分组
    If arrIndex < GROUP_SIZE - 1 Then
        MsgBox "工作表数量不足12个，无法完成分组求和"
        wkbRef.Close False
        Application.ScreenUpdating = True
        Exit Sub
    End If
    
    ' 分组求和写入结果
    For i = 0 To arrIndex - (GROUP_SIZE - 1)
        wkbCurrent.Sheets(OUTPUT_SHEET).Cells(START_OUTPUT_ROW + i, "Q").Value = _
            Application.Sum(Application.Index(Application.Transpose(arr), Evaluate("ROW(" & (1 + i) & ":" & (GROUP_SIZE + i) & ")"), 0))
    Next i
    
    ' 关闭外部工作簿不保存
    wkbRef.Close False
    Application.ScreenUpdating = True
End Sub

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