Excel VBA嵌套For循环问题

Question

我有一个包含 60 张纸的大型数据集，我需要从中分别提取每张纸的三个值。这些值将汇总在一张纸上，以便我可以对数据进行概览。

我参加了 VBA 网络速成课程，尝试编写宏以避免手动执行此操作。我的想法（我能够转换为代码）是将每张纸上的三个单元格复制到二维数组的行中，因此我最终会得到一个 [60x3] 矩阵，可以将其复制到新创建的表格中'。 （我知道这是非常低效的，但这是我目前能想到的最好的方法。）

代码运行但产生了不良结果：矩阵仅由最终工作表中的三组值组成。我的宏真正需要的是它从 sheet1 复制三个值并将它们粘贴到 MeanTable(1,:)，然后从 sheet2 复制三个值并将它们粘贴到 MeanTable(2,:) 等等。我确信这种情况正在发生，因为我的第一个嵌套循环是垃圾，所以我一直在尝试不同的循环并添加循环（当然还有网络搜索），但到目前为止我还没有解决它。

Sub copy_to_one_sheet() 'copy sample means from each sheet to Means
Application.ScreenUpdating = False

Dim ws As Worksheet
Dim NumSheets As Integer
Dim NumSamples As Integer
Dim MeanTable() As Long 'store sample means in this 2D array, its size defined by number of sheets and samples per sheet
NumSheets = Application.Sheets.Count 'count number of sheets
NumSamples = 3 'number of samples per sheet (hardcoded for now)
ReDim MeanTable(NumSheets, 1 To NumSamples) 'MeanTable will be filled with sample means

'============================================
'= copy sample means per sheet to MeanTable =
'============================================
For i = 1 To UBound(MeanTable, 1) 'copy sample means from fixed columns per sheet to individual rows of Table array

    For Each ws In ThisWorkbook.Worksheets 'go through sheets

        MeanTable(i, 1) = ws.Cells(Rows.Count, 3).End(xlUp).Offset(-3, 0).Value
        MeanTable(i, 2) = ws.Cells(Rows.Count, 10).End(xlUp).Offset(-3, 0).Value
        MeanTable(i, 3) = ws.Cells(Rows.Count, 17).End(xlUp).Offset(-3, 0).Value

    Next ws
Next i
'=============================================
'= create Sheet("Means") and paste MeanTable =
'=============================================
With ThisWorkbook
    Set Dst = .Sheets.Add(After:=.Sheets(.Sheets.Count)) 'create new worksheet
    Dst.Name = "Means" 'worksheet name
    With Sheets("Means")
        For k = 1 To UBound(MeanTable, 1)
            For l = 1 To NumSamples
                Cells(k, l).Value = MeanTable(k, l) 'paste Table variable with sample means to new worksheet ("Means")
            Next l
        Next k
    End With
End With
End Sub

我的问题是：如何让我的循环在工作簿中的每个工作表中循环，并将三组值复制到 MeanTable 的相应行，然后再转到下一个工作表？

任何帮助将不胜感激！

Answer 1

For i = 1 To UBound(MeanTable, 1) 需要替换为计数器 i = i + 1`。使用 Range.Resize 填充数组中的范围。

Sub copy_to_one_sheet()                               'copy sample means from each sheet to Means
    Application.ScreenUpdating = False

    Dim ws As Worksheet
    Dim NumSheets As Integer
    Dim NumSamples As Integer
    Dim MeanTable() As Long                           'store sample means in this 2D array, its size defined by number of sheets and samples per sheet
    NumSheets = Application.Sheets.Count              'count number of sheets
    NumSamples = 3                                    'number of samples per sheet (hardcoded for now)
    ReDim MeanTable(1 To NumSheets, 1 To NumSamples)  'MeanTable will be filled with sample means

    For Each ws In ThisWorkbook.Worksheets            'go through sheets
        i = i + 1
        MeanTable(i, 1) = ws.Cells(Rows.Count, 3).End(xlUp).Offset(-3, 0).Value
        MeanTable(i, 2) = ws.Cells(Rows.Count, 10).End(xlUp).Offset(-3, 0).Value
        MeanTable(i, 3) = ws.Cells(Rows.Count, 17).End(xlUp).Offset(-3, 0).Value

    Next ws

    With ThisWorkbook
        Set Dst = .Sheets.Add(After:=.Sheets(.Sheets.Count))    'create new worksheet
        Dst.Name = "Means"                            'worksheet name
        With Sheets("Means")
            .Range("A1").Resize(UBound(MeanTable, 1), UBound(MeanTable, 2)).Value = MeanTable

        End With
    End With
End Sub