excel - 如何让 "copy-paste"宏运行得更快？

Question

我在 Excel VBA 中编写了一个宏，它基本上复制粘贴 53 行 1440 次，一个在另一个之下，以便在 ~70000 行表中填充两列。该宏有效，但完全运行大约需要五分钟。如果我不必在大约 1000 个其他文件上运行它，这会很好。我正在寻找任何方法来加快这个过程，这样它就不需要 5 天的时间来运行。

我尝试使用范围复制方法:

    Set range1 = {the table I'm copying} 
    Set range2 = {the cells I want to paste into} 
    range1.Copy range2

但它花了同样长的时间，如果不是更长的话。

这是我当前的代码:

    Windows("as_built_comp.xlsm").Activate
    Sheets(siteName).Activate
    j = Cells(Rows.Count, 1).End(xlUp).Row
    Range("C2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    wb.Activate
    Range("I12").Select
    For i = 1 To 1440
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, 
              SkipBlanks _
        :=False, Transpose:=False
        ActiveWindow.SmallScroll Down:=56
        ActiveCell.Offset(j - 1, 0).Select
    Next i

我认为该解决方案可能与在 VBA 中使用 sql 有关，但我尚未学习该语法。无论哪种方式，任何建议都将不胜感激。感谢您的阅读!

Answer 1

将其全部加载到一个数组中，然后在最后输出整个数组。重构代码以避免使用激活/选择

Sub tgr()

    Dim wbDest As Workbook
    Dim wbData As Workbook
    Dim wsDest As Worksheet
    Dim wsData As Worksheet
    Dim aTemp() As Variant
    Dim aData() As Variant
    Dim SiteName As String
    Dim RepeatData As Long
    Dim ixTemp As Long
    Dim ixData As Long
    Dim ixCol As Long

    SiteName = "SiteName1"
    RepeatData = 1440

    Set wbDest = ThisWorkbook
    Set wbData = Workbooks("as_built_comp.xlsm")
    Set wsDest = wbDest.Worksheets(1)
    Set wsData = wbData.Worksheets(SiteName)

    With wsData.Range("C2:D" & wsData.Cells(wsData.Rows.Count, "C").End(xlUp).Row)
        If .Row < 2 Then Exit Sub   'No data
        aTemp = .Value
        ReDim aData(1 To .Rows.Count * RepeatData, 1 To .Columns.Count)
    End With

    For ixData = 1 To UBound(aData, 1)
        ixTemp = ((ixData - 1) Mod UBound(aTemp, 1)) + 1
        For ixCol = 1 To UBound(aTemp, 2)
            aData(ixData, ixCol) = aTemp(ixTemp, ixCol)
        Next ixCol
    Next ixData

    wsDest.Range("I12").Resize(UBound(aData, 1), UBound(aData, 2)).Value = aData

End Sub