VBA报错Worksheet subscript out of range 无法定位目标工作表

问题现象 #

• 开发VBA脚本实现打开服务器存储的工作簿、复制数据的功能，单台PC运行时触发subscript out of range（下标越界）错误
• 报错触发点为代码最后一行引用目标工作簿指定工作表的语句，脚本可正常打开目标工作簿，两台PC的网络映射盘符配置完全一致

原逻辑与代码 #

脚本预设执行逻辑：

1. 定位值为前一日日期（Date - 1）的列，记录列号i
2. 循环左移列号：如果当前列第2行单元格有填充色（标记为无效项），就继续向左查找，直到找到第2行无填充的有效列，取该列第3行的值作为要引用的工作表名称sht
3. 打开服务器上的目标工作簿，引用名为sht的工作表
   原代码如下：

Sub importData()
    Dim sht As String
    Dim i As Integer
    sht = Cstr(Date - 1)
    Dim Temp(1 To 38) As String
    
    For i = 4 To 42
        If Cells(3, i).Value = sht Then
            Exit For
        End If
    Next i
    
    While Cells(2, i).Interior.ColorIndex <> xlColorIndexNone
        i = i - 1
        sht = Cells(3, i).Value
    Wend
    
    Workbooks.Open "path to file & filename.xlsm"
    Workbooks("filename").Worksheets(sht)
End Sub

故障根因 #

• 未显式指定单元格所属工作表，跨设备活动表不一致：所有Cells调用都没有绑定父工作表，默认读取当前活动工作表的内容。两台PC打开宏文件时默认激活的工作表如果不同，查找列、取sht值的逻辑就会在错误的表上执行，最终拿到的sht值和目标工作簿内的实际工作表名不匹配，触发越界。
• 系统区域格式差异导致日期字符串不匹配：CStr(Date -1)的输出完全依赖Windows系统的短日期配置，比如一台PC格式为yyyy/m/d，另一台为yyyy-mm-dd或m/d/yyyy，哪怕对应日期值正确，转成字符串后也会和固定命名的工作表名存在格式差，字符串全等匹配会失败。
• 工作簿引用逻辑存在兼容问题：Workbooks("filename")仅写文件名不带后缀，部分Office版本下打开.xlsm文件时，工作簿集合的键名需要带完整后缀才能匹配；如果服务器文件加载存在延迟，文件未完全就绪就执行下一行引用，也会出现识别失败。
• 缺少边界校验逻辑：左移列号的循环没有设置最小列号限制，如果从初始位置到第1列所有单元格都带填充色，i会减到0甚至负数，此时读取单元格值拿到的sht本身就是无效值。

修复方案 #

1. 所有单元格、工作簿、工作表调用都显式绑定父对象，不依赖默认活动对象
2. 用Format函数统一日期输出格式，和目标工作表的命名规则保持一致，规避系统区域设置差异
3. 打开工作簿时直接赋值给工作簿对象变量，省去后续靠文件名字符串匹配的步骤
4. 增加循环边界判断、存在性校验，避免无效值触发报错
   修复后可直接运行的代码如下：

Sub importData()
    Dim sht As String
    Dim i As Integer
    Dim wbTarget As Workbook
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    ' 显式指定宏文件内存储日期列的工作表，替换为实际表名即可
    Set wsSource = ThisWorkbook.Worksheets("存放日期配置的表名")
    
    ' 统一日期格式，和目标工作簿的工作表命名规则对齐，比如工作表是2024-05-20格式就保留"yyyy-mm-dd"
    sht = Format(Date - 1, "yyyy-mm-dd")
    Dim Temp(1 To 38) As String
    
    ' 所有单元格操作绑定到指定的源工作表
    For i = 4 To 42
        If wsSource.Cells(3, i).Value = sht Then
            Exit For
        End If
    Next i
    
    ' 增加列号最小边界判断，防止i减到0以下
    While i >= 1 And wsSource.Cells(2, i).Interior.ColorIndex <> xlColorIndexNone
        i = i - 1
        sht = wsSource.Cells(3, i).Value
    Wend
    
    ' 校验是否找到有效列
    If i < 1 Then
        MsgBox "未找到匹配的有效日期列，请检查源数据配置"
        Exit Sub
    End If
    
    ' 打开目标工作簿时直接绑定到对象变量，替换为实际的服务器完整文件路径
    Set wbTarget = Workbooks.Open("\\服务器地址\实际路径\filename.xlsm")
    
    ' 校验目标工作表是否存在
    On Error Resume Next
    Set wsTarget = wbTarget.Worksheets(sht)
    On Error GoTo 0
    
    If wsTarget Is Nothing Then
        MsgBox "目标工作簿中不存在名为【" & sht & "】的工作表，请检查命名规则或文件内容"
        wbTarget.Close SaveChanges:=False
        Exit Sub
    End If
    
    ' 后续直接通过wsTarget对象操作目标工作表完成数据复制即可
End Sub

如果调整后仍报错，可以手动在故障PC上打开目标工作簿，检查对应日期的工作表名是否存在前后空格、不可见特殊字符，这类文件同步带来的异常字符也会导致字符串匹配失败。

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