Question

我有一个包含60张纸的大型数据集，我需要从中单独提取每张纸的三个值。这些值将在一个表格中汇总，因此我可以对数据进行概述。

我在VBA中参加了一个互联网速成课程，尝试编写一个宏来避免手动执行此操作。我的想法（我能够转换为代码）是将每张纸的三个单元格复制到2D数组的行中，所以我最终会得到一个[60x3]矩阵，可以将其复制到新创建的工作表中＃＆ 39的装置;＆＃39 ;. （我知道这是非常低效的，但它是我现在能想到的最好的。）

代码运行但会产生不良结果：矩阵只包含最终工作表中的三个值。我从宏中实际需要的是它从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

需要用计数器i = i + 1`替换

For i = 1 To UBound(MeanTable, 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

Excel VBA嵌套For循环问题

1 个答案: