VBA读取已打开工作簿报错：运行时错误9（下标越界）求助

看起来你遇到的核心问题是无法正确引用第三个打开的工作簿，导致触发下标越界错误。结合你的代码描述，我帮你拆解几个关键问题和对应的修复方案：

一、文件名截取逻辑错误（最可能的原因） #

你用InStr(Range("C7"), ".xlsm")来截取文件名，但InStr会找到第一个出现的点，如果文件名里有其他点（比如版本号、命名中的点），就会截取到错误的工作簿名称，导致Workbooks(txtMSR)找不到目标文件。

修复方法：用InStrRev找最后一个点 #

把截取文件名的代码改成：

' 截取不带扩展名的工作簿名称（从末尾找第一个点的位置）
txtMSR = Left(Range("C7"), InStrRev(Range("C7"), ".") - 1)
txtWorkbook = Left(Range("C13"), InStrRev(Range("C13"), ".") - 1)

InStrRev会从字符串末尾开始查找第一个点，确保截取的是完整的文件名（不含扩展名）。

二、提前验证工作簿是否存在 #

即使截取了正确的名称，也可能因为大小写不匹配、工作簿被意外关闭等原因导致找不到。建议在访问工作簿前先做验证：

添加验证函数 #

' 检查指定名称的工作簿是否已打开
Function WorkbookIsOpen(wbName As String) As Boolean
    Dim targetWB As Workbook
    On Error Resume Next
    Set targetWB = Workbooks(wbName)
    On Error GoTo 0
    WorkbookIsOpen = Not targetWB Is Nothing
End Function

在代码中调用验证 #

' 先检查目标工作簿是否打开
If Not WorkbookIsOpen(txtMSR) Then
    MsgBox "工作簿 " & txtMSR & " 未打开，请确认后重试！", vbExclamation
    Exit Sub
End If

If Not WorkbookIsOpen(txtWorkbook) Then
    MsgBox "工作簿 " & txtWorkbook & " 未打开，请确认后重试！", vbExclamation
    Exit Sub
End If

三、优化工作表引用，避免重复调用 #

重复写Workbooks(txtWorkbook).Sheets("ps")不仅繁琐，还容易出错。建议提前将工作表对象赋值给变量：

Dim wsHRReport As Worksheet ' HR导出的报表工作表（ps）
Dim wsMSR As Worksheet ' 本周待处理ID的工作表（MSR）

' 赋值工作表对象
Set wsHRReport = Workbooks(txtWorkbook).Sheets("ps")
Set wsMSR = Workbooks(txtMSR).Sheets("MSR")

四、修正循环逻辑和单元格引用错误 #

你的代码里还有两个小问题：

1. 错误引用了Sheets("ps")（应该是Sheets("MSR")）；
2. 把匹配标记写到了固定的N1单元格，应该对应到当前循环行的N列。

优化后的完整循环代码 #

Dim lastRowHR As Long, lastRowMSR As Long
Dim vLoop As Long, vLoop2 As Long
Dim vPMKeyS As String

' 获取两列的最后一行（避免中间有空单元格导致循环提前终止）
lastRowHR = wsHRReport.Range("A" & wsHRReport.Rows.Count).End(xlUp).Row
lastRowMSR = wsMSR.Range("A" & wsMSR.Rows.Count).End(xlUp).Row

' 遍历HR报表的Empl ID
For vLoop = 2 To lastRowHR
    vPMKeyS = wsHRReport.Range("A" & vLoop).Value
    
    ' 遍历MSR工作表的Emplid
    For vLoop2 = 2 To lastRowMSR
        If vPMKeyS = wsMSR.Range("A" & vLoop2).Value Then
            wsHRReport.Range("N" & vLoop).Value = "Y" ' 标记到当前行的N列
            Exit For ' 找到匹配后跳出内层循环，提升效率
        End If
    Next vLoop2
Next vLoop

额外建议：避免依赖单元格存储文件名 #

如果可能的话，建议在选择文件时直接获取Workbook对象，而不是靠单元格里的文件名。比如用Application.GetOpenFilename选择文件，然后直接赋值：

Dim msrWB As Workbook
Dim filePath As Variant

filePath = Application.GetOpenFilename("Excel文件 (*.xlsm;*.xls), *.xlsm;*.xls")
If filePath <> False Then
    Set msrWB = Workbooks.Open(filePath)
    Set wsMSR = msrWB.Sheets("MSR")
End If

这样完全避免了文件名截取的问题，更可靠。

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