如何使一个简单的“求和”循环更快？

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

只需一次完成所有操作。循环只会增加处理单个迭代的时间。

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

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

End With

Answer 2

使用变量数组来限制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

---

编辑

SUM（INDEX（））较慢，只是单独添加零件更快。

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

对50,000行进行了测试，结果几乎是瞬时的。

Answer 3

您可以使用单行代码将求和公式插入P列的每一行，而不是遍历每一行：

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

假设4是开始行，变量lr是最后一行。

Answer 4

使用数组更快

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