Question

希望我说得对......

我在网上看到一些东西说复制和粘贴浪费了宝贵的时间。最好直接分配值，而不使用excel函数。

我在VBA书中找到了一个解释如何在2D数组中存储范围的部分。

现在，如果我想使用此方法将动态数量的工作表中的范围复制并粘贴到另一个主工作表中，该怎么办？

在我的脑海中，我想象将越来越多的值堆叠到一个数组中，然后将数组转储到我想要的位置，进入一个范围，其大小由大数组的维度定义。

在实践中，我设法创建的所有内容如下所示，依次为每个工作表执行相同的简单操作。

有可能做得更好吗？那运行得更快？帮助一个兄弟！

Sub arrayCopyPaste()

Dim Obj As Range
Dim Data As Variant
Dim ws As Worksheet
Dim sheetCount As Integer
Dim LR As Integer

sheetCount = Sheets.Count

Set ws = Sheets.Add
ws.Move After:=Worksheets(Worksheets.Count)

For i = 1 To sheetCount
    Data = Sheets(i).Range("A1:B9")
    LR = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    Set Obj = ws.Range("A" & LR)
    Set Obj = Obj.Resize(UBound(Data, 1), UBound(Data, 2))
    Obj.Value = Data
Next i
End Sub

Answer 1

对于我使用的任何代码，我喜欢调用我做的这个例程：

Sub SpeedupCode(Optional ByVal Val As Boolean = True)

    With Application
        If Val = True Then
            .ScreenUpdating = False
            .Calculation = xlCalculationManual
        Else
            .ScreenUpdating = True
            .Calculation = xlCalculationAutomatic
        End If
    End With

End Sub

因此，在您的代码中，您只需按如下方式使用它：

Sub arrayCopyPaste()

    Dim Obj As Range
    Dim Data As Variant
    Dim ws As Worksheet
    Dim sheetCount As Integer
    Dim LR As Integer

    SpeedupCode

    sheetCount = Sheets.Count

    Set ws = Sheets.Add
    ws.Move After:=Worksheets(Worksheets.Count)

    For i = 1 To sheetCount
        Data = Sheets(i).Range("A1:B9")
        LR = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
        Set Obj = ws.Range("A" & LR)
        Set Obj = Obj.Resize(UBound(Data, 1), UBound(Data, 2))
        Obj.Value = Data
    Next i

    SpeedupCode False

End Sub

虽然这不一定优化您的代码，但它可以显着提高您执行的每个项目的性能。如果您的代码需要工作表中新计算的变量，您可以在获取该变量之前始终使用Application.Calculate，但通常不需要它。

Answer 2

由于一次性写入结果，这个版本的效率稍高一些，但除非您使用的是非常大的范围，否则您可能不会发现太多差异。

Sub test()

    'Same as original: final array is 2 columns wide, (3 * number of sheets) rows long
    Call mergeRangeValues("A1:B3", "Results", True)

    'Alternate version: final array is 3 rows long, (2 * number of sheets) columns wide
    'Call mergeRangeValues("A1:B3", "Results", False)

End Sub
Sub mergeRangeValues(rngString As String, newWSName As String, stackRows As Boolean)
'Merges the same range (rngString) from all sheets in a workbook
'Adds them to a new worksheet (newWSName)
'If stackRows = True, values are stacked vertically
'If stackRows = False, values are stacked horizontally

    Dim sheetCount As Long
    Dim newWS As Worksheet
    sheetCount = ThisWorkbook.Sheets.Count
    Set newWS = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(sheetCount))
    newWS.Name = newWSName

    Dim numCols As Long
    Dim numRows As Long
    numCols = newWS.Range(rngString).Columns.Count * IIf(stackRows, 1, sheetCount)
    numRows = newWS.Range(rngString).Rows.Count * IIf(stackRows, sheetCount, 1)
    ReDim resultsArr(1 To numRows, 1 To numCols) As Variant
    '''Longer version:
    'If stackRows Then
        'numCols = newWS.Range(rngString).Columns.Count
        'numRows = newWS.Range(rngString).Rows.Count * sheetCount
    'Else
        'numCols = newWS.Range(rngString).Columns.Count * sheetCount
        'numRows = newWS.Range(rngString).Rows.Count
    'End If
    '''ie "If you want to stack the results vertically, make the array really long"
    '''or "If you want to stack the results horizontally, make the array really wide"

    Dim i As Long
    For i = 0 To sheetCount - 1
        Dim tempArr As Variant
        tempArr = ThisWorkbook.Sheets(i + 1).Range(rngString).Value
        Dim j As Long
        Dim k As Long
        If stackRows Then
            For j = LBound(tempArr, 1) To UBound(tempArr, 1)
                For k = LBound(tempArr, 2) To UBound(tempArr, 2)
                    resultsArr(j + i * (numRows / sheetCount), k) = tempArr(j, k)
                Next
            Next
        Else
            For j = LBound(tempArr, 1) To UBound(tempArr, 1)
                For k = LBound(tempArr, 2) To UBound(tempArr, 2)
                    resultsArr(j, k + i * (numCols / sheetCount)) = tempArr(j, k)
                Next
            Next
        End If
    Next

    With newWS
        .Range(.Cells(1, 1), .Cells(numRows, numCols)).Value = resultsArr
    End With

End Sub

Answer 3

我倾向于使用你当前的方法并将其煮沸一点。

Sub arrayCopyPaste()

    Dim ws As Worksheet

    Set ws = Sheets.Add(After:=Worksheets(Worksheets.Count))

    For i = 1 To Sheets.Count - 1
        With Sheets(i).Range("A1:B9")
            ws.Cells(ws.Rows.Count, 1).End(xlUp).Offset(1, 0).Resize( _
                        .Rows.Count, .Columns.Count).Value = .Value
        End With
    Next i

End Sub

将多个范围堆叠成动态数组

3 个答案:

因此，在您的代码中，您只需按如下方式使用它：