Excel VBA遍历行列时触发Subscript out of range错误求助

错误原因分析 #

出现"subscript out of range"（下标越界）的核心原因如下：

• 工作表/列表对象名称不匹配：如果cone6、output工作表或testTable列表对象的实际名称与代码拼写不一致，会直接触发下标越界。
• 循环范围错误：
  1. wsSrc.UsedRange.Find获取的LastRow包含列表表头行，但ListObjects("testTable").DataBodyRange仅包含数据行，循环i = 1 To LastRow会超出数据行范围。
  2. LastCol是整个工作表的最后列，直接用此范围循环会导致ListColumns("material_" & j)调用不存在的列，触发下标越界。
• 错误处理不当：On Error Resume Next掩盖了真实错误，无法定位具体问题点。

修正后的代码 #

Sub ExtractRecipes()
    Dim wsSrc As Worksheet
    Dim wsDest As Worksheet
    Dim tbl As ListObject
    Dim recipeCol As ListColumn
    Dim dataRows As Long
    Dim matColCount As Long
    Dim i As Long, j As Long, RowCounter As Long
    
    ' 验证工作表和列表对象是否存在，提前拦截错误
    On Error GoTo ErrorHandler
    Set wsSrc = ThisWorkbook.Worksheets("cone6")
    Set wsDest = ThisWorkbook.Worksheets("output")
    Set tbl = wsSrc.ListObjects("testTable")
    On Error GoTo 0 ' 关闭全局错误捕获
    
    ' 获取配方列和数据行数
    Set recipeCol = tbl.ListColumns("recipe")
    dataRows = tbl.DataBodyRange.Rows.Count
    
    ' 统计所有以material_开头的列数，作为原料循环范围
    matColCount = 0
    For Each col In tbl.ListColumns
        If Left(col.Name, 9) = "material_" Then
            matColCount = matColCount + 1
        End If
    Next col
    
    RowCounter = 1
    ' 清空输出表（可根据需求注释此行）
    wsDest.Cells.Clear
    
    With wsDest
        ' 写入输出表头（可根据需求删除）
        .Cells(RowCounter, 1) = "配方名称"
        .Cells(RowCounter, 2) = "原料名称"
        .Cells(RowCounter, 3) = "用量"
        RowCounter = RowCounter + 1
        
        ' 遍历每个配方数据行
        For i = 1 To dataRows
            Dim recipeName As String
            recipeName = recipeCol.DataBodyRange.Cells(i).Value
            
            ' 遍历每个原料列
            For j = 1 To matColCount
                Dim matNameCol As ListColumn
                Dim matAmtCol As ListColumn
                Set matNameCol = tbl.ListColumns("material_" & j)
                Set matAmtCol = tbl.ListColumns("material_amount_" & j)
                
                ' 仅处理非空的原料项
                If matNameCol.DataBodyRange.Cells(i).Value <> "" Then
                    .Cells(RowCounter, 1) = recipeName
                    .Cells(RowCounter, 2) = matNameCol.DataBodyRange.Cells(i).Value
                    .Cells(RowCounter, 3) = matAmtCol.DataBodyRange.Cells(i).Value
                    RowCounter = RowCounter + 1
                End If
            Next j
        Next i
    End With
    
    Exit Sub
ErrorHandler:
    MsgBox "错误：" & Err.Description & vbCrLf & "请检查工作表或列表对象名称是否正确", vbCritical
End Sub

关键修改点 #

• 增加存在性验证：通过针对性错误捕获，提前检查工作表和列表对象是否存在，给出明确提示。
• 修正循环范围：
  1. 使用tbl.DataBodyRange.Rows.Count获取真实数据行数，避免循环越界。
  2. 统计material_前缀的列数作为循环上限，确保只遍历存在的原料列。
• 优化输出逻辑：每个配方名称仅在对应原料非空时写入，符合"配方-原料-用量"的关联需求。
• 替换错误处理：移除全局错误掩盖，改用定向错误捕获，便于定位问题。

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