Excel VBA 中循环行和列时出错

Question

您好 Excel stackoverflow，

我有 JavaScript/jQuery 背景，以及一些 PHP/SQL 背景，但 VBA 的语法对我来说仍然很新且令人困惑。

正如标题所说，我想在VBA中循环遍历行和列。我有一张陶瓷釉料的配方表，如下存储：

并非所有食谱都含有相同数量的成分。有些有很多，有些只有很少。我想生成一个食谱列表，其中包含食谱标题，后跟成分和每种成分的数量，如下所示：

我找到了一个可以生成我想要的内容的解决方案，但我收到“下标超出范围”错误，并且不明白为什么或如何解决它。我修改了here:

找到的代码片段

Sub ExtractRecipes()

    Dim wsSrc As Worksheet: Set wsSrc = Worksheets("cone6")
    Dim wsDest As Worksheet: Set wsDest = Worksheets("output")
    Dim LastRow As Long: LastRow = wsSrc.UsedRange.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).row
    Dim LastCol As Long: LastCol = wsSrc.UsedRange.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
    Dim i As Long, j As Long, RowCounter As Long: RowCounter = 1
    On Error Resume Next

    With wsDest
        For i = 1 To LastRow
            .Cells(RowCounter, 1) = wsSrc.ListObjects("testTable").ListColumns("recipe").DataBodyRange.Cells(i)
            For j = 1 To LastCol
                If wsSrc.ListObjects("testTable").DataBodyRange.Cells(i, j) <> "" Then
                    .Cells(RowCounter + 1, 1) = wsSrc.ListObjects("testTable").ListColumns("material_" & j).DataBodyRange.Cells(i)
                    .Cells(RowCounter + 1, 2) = wsSrc.ListObjects("testTable").ListColumns("material_amount_" & j).DataBodyRange.Cells(i)
                    .Cells(RowCounter + 1, 3) = Err.Description
                    RowCounter = RowCounter + 1
                End If
            Next j
        Next i
    End With

End Sub

这是我当前得到的输出：

任何人都可以向新手解释我做错了什么吗？谢谢！

注意：对于任何可能偶然发现这一点的陶瓷人来说，这些食谱不是真实的；）

Answer 1

未经测试，但类似的东西应该可以工作：

Sub ExtractRecipes()

    Dim wsSrc As Worksheet, wsDest As Worksheet, lo As ListObject, col As Long
    Dim RowCounter As Long, rw As Range, rec, mat, amt
    
    Set wsSrc = Worksheets("cone6")
    Set lo = wsSrc.ListObjects("testTable")
    
    Set wsDest = Worksheets("output")
    RowCounter = 1
    
    For Each rw In lo.DataBodyRange.Rows   'loop rows in listobject
        rec = rw.Cells(1).Value            'recipe
        If Len(rec) > 0 Then               'have entry?
            wsDest.Cells(RowCounter, 1).Value = rec
            For col = 2 To lo.ListColumns.Count Step 2
                mat = rw.Cells(col).Value
                amt = rw.Cells(col + 1).Value
                If Len(mat) > 0 Then '+ test amount?
                    RowCounter = RowCounter + 1
                    wsDest.Cells(RowCounter, 1).Resize(1, 2).Value = Array(mat, amt)
                End If
            Next col
            RowCounter = RowCounter + 1 'add empty row between
        End If
    Next rw
End Sub