Как заставить макрос «копировать-вставить» работать быстрее?

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

Я думаю, что решение может иметь какое-то отношение к использованию sql в VBA, но я еще не изучил этот синтаксис. В любом случае, любой совет очень ценится. Спасибо за чтение!

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