Как сделать простой цикл «Сумма» быстрее?

Question

Я начинаю учиться использовать циклы и массивы, но этот застрял у меня. Ниже приведен код, который проходит по ячейкам и складывает их вместе в столбце P.

Sub Loop_Test()

Dim sht1 As Worksheet
Dim lr As Long
Dim i As Long

Set sht1 = Worksheets("Sheet1")
lr = Fcst.Cells(Rows.Count, "A").End(xlUp).Row

    With sht1
        For i = 4 To lr

            .Range("P" & i).Value = Application.Sum(Range("D" & i, "O" & i))

        Next 
    End With

End Sub

В целом, этот код работает, но он очень медленный, и мне нужно применить его к тысячам строк. Я знаю, что для того, чтобы сделать это быстрее, мне нужно превратить диапазон сумм в массив, но я не совсем уверен, как это сделать, когда включен цикл.

Любая помощь будет принята с благодарностью.

Спасибо

G

Отказ от ответственности: я знаю, что есть более эффективные способы суммировать ячейки вместе, но это только я играю и учусь.

Answer 1

быстрее с массивом

Sub Loop_Test()

    Const cSheet1 As Variant = "Sheet1"
    Const cSheet2 As Variant = "Sheet2"
    Const fr As Integer = 4

    Dim sht1 As Worksheet
    Dim fcst As Worksheet
    Dim lr As Long
    Dim i As Long
    Dim vnt As Variant

    Set sht1 = Worksheets(cSheet1)
    Set fcst = Worksheets(cSheet2)

    With fcst

        lr = .Cells(.Rows.Count, "A").End(xlUp).Row

        ReDim vnt(1 To lr - fr + 1, 1 To 1)

        For i = 1 To UBound(vnt)
            vnt(i, 1) = WorksheetFunction.Sum( _
                    .Range("D" & i + fr - 1, "O" & i + fr - 1))
        Next

    End With

    sht1.Cells(fr, "P").Resize(UBound(vnt)) = vnt

End Sub

Answer 2

Вместо того, чтобы зацикливаться на каждой строке, вы можете вставить формулу суммирования в каждую строку столбца P одной строкой кода:

.Range("P4:P" & lr).Formula="=SUM(D4:O4)"

при условии, что 4 - начальная строка, а ваша переменная lr - последняя строка.

Answer 3

Используйте вариантный массив, чтобы ограничить количество обращений vba к рабочим листам:

Sub Loop_Test()

    Dim sht1 As Worksheet
    Set sht1 = Worksheets("Sheet1")

    Dim fcst As Worksheet
    Set fcst = Worksheets("Sheet2")

    Dim lr As Long
    lr = fcst.Cells(Rows.Count, "A").End(xlUp).Row

    Dim dta As Variant
    dta = fcst.Range(fcst.Cells(4, "D"), fcst.Cells(lr, "O")).Value

    Dim otpt As Variant
    ReDim otpt(1 To UBound(dta, 1), 1 To 1)

    With sht1
        Dim i As Long
        For i = LBound(dta, 1) To UBound(dta, 1)
            otpt(i, 1) = Application.Sum(Application.Index(dta, i, 0))
        Next i

        .Range("P4").Resize(UBound(dta, 1), 1).Value = otpt
    End With

End Sub

---

Редактировать

СУММА (ИНДЕКС ()) медленная, быстрее добавить отдельные части.

Sub Loop_Test()

    Dim sht1 As Worksheet
    Set sht1 = Worksheets("Sheet1")

    Dim fcst As Worksheet
    Set fcst = Worksheets("Sheet2")

    Dim lr As Long
    lr = fcst.Cells(Rows.Count, "A").End(xlUp).Row

    Dim dta As Variant
    dta = fcst.Range(fcst.Cells(4, "D"), fcst.Cells(lr, "O")).Value

    Dim otpt As Variant
    ReDim otpt(1 To UBound(dta, 1), 1 To 1)

    With sht1
        Dim i As Long
        For i = LBound(dta, 1) To UBound(dta, 1)
            Dim j as Long
            For j = lbound(dta,2) to ubound(dta,2)
                otpt(i, 1) = otpt(i, 1) + dta(i, j) 
            Next j
        Next i

        .Range("P4").Resize(UBound(dta, 1), 1).Value = otpt
    End With

End Sub

Проверено на 50000 строк и результат был почти мгновенным.

Answer 4

Просто сделай их все сразу. Цикл только добавляет время для обработки отдельных итераций.

With sht1.Range(sht1.cells(4, "P"), sht1.cells(lr, "P"))

    .formula = "=sum(D4:O4)"
    .Value = .value

End With