此工作表 Sum Function 非常慢 - 加快速度的想法？

Question

我有以下總和 function 需要很多時間才能給出 output：

Sub Sum_multiple_columns()
    Dim ws As Worksheet
    Dim destinationLastRow As Long, i As Long
    Dim TotalCoverage As Double
    Dim rng As Range, MyResultsRng As Range
    Dim cell As Range
    
    Const FirstCol As Long = 12 ' "L"
    Const LastCol As Long = 24 ' "X"
    Const TotalCoverageColumn As Long = 9
    Set ws = ThisWorkbook.Worksheets("Master")
    destinationLastRow = ws.Range("A" & Rows.Count).End(xlUp).Row
    For i = 5 To destinationLastRow
        Set MyResultsRng = ws.Range("K" & i)
        For Each cell In MyResultsRng
            Set rng = ws.Range(ws.Cells(i, FirstCol), ws.Cells(i, LastCol))
            TotalCoverage = Application.WorksheetFunction.Sum(rng.Value)
            With MyResultsRng
                .Value = TotalCoverage
                .HorizontalAlignment = xlCenter
                .Font.Color = RGB(40, 101, 156)
                .Font.Bold = True
                .Font.Size = 9
                .Font.Name = "Calibri"
                .NumberFormat = "0.00"
             End With
        Next cell
    Next i
End Sub

在您看來，我如何才能加快此代碼的速度，該代碼旨在對從 L 列到 X 的值求和並將結果放入列表中每一行的 K 列中。

謝謝

Answer 1

請嘗試下一種方法：

Sub Sum_multiple_columns()
    Dim ws As Worksheet, destinationLastRow As Long, i As Long
    
    Const FirstCol As Long = 12 ' "L"
    Const LastCol As Long = 24 ' "X"
    Const TotalCoverageColumn As Long = 9
    
    Set ws = ThisWorkbook.Worksheets("Master")
    destinationLastRow = ws.Range("A" & rows.count).End(xlUp).row
    For i = 5 To destinationLastRow
        ws.Range("K" & i).Value = Application.WorksheetFunction.Sum(ws.Range(ws.cells(i, FirstCol), ws.cells(i, LastCol)))
    Next i
    With ws.Range("K5:K" & destinationLastRow)
        .HorizontalAlignment = xlCenter
        .Font.color = RGB(40, 101, 156)
        .Font.Bold = True
        .Font.Size = 9
        .Font.Name = "Calibri"
        .NumberFormat = "0.00"
    End With
End Sub

未經測試，但如果我沒有遺漏任何東西，它應該可以工作......

Answer 2

好的，讓我們完全跳過循環。

Sub Sum_multiple_columns()
    Const FirstCol As Long = 12 ' "L"
    Const LastCol As Long = 24 ' "X"
    Const OutputColumn As Long = 11 ' "K"

    Dim ws As Worksheet, LastRow As Long, OutputRange As Range
    Dim FirstSumRow As Range, FirstSumTarget As String

    Set ws = ThisWorkbook.Worksheets("Master")
    LastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    Set OutputRange = ws.Range(ws.Cells(5, OutputColumn), ws.Cells(LastRow, OutputColumn))
    Set FirstSumRow = ws.Range(ws.Cells(5, FirstCol), ws.Cells(5, LastCol))
    FirstSumTarget = FirstSumRow.Address(False, True, xlA1, False)

    Dim tmpCalc AS xlCalculation: tmpCalc = Application.Calculation 'Save setting
        Application.Calculation = xlCalculationManual 'Makes things slightly faster
    
    With OutputRange
        .Formula = "=SUM(" & FirstSumTarget  & ")" 'This will fill down automatically
        .Calculate 'Needed because Calculation is currently manual
        .Value = .Value 'Convert the formulae into flat values
        
        .HorizontalAlignment = xlCenter
        .Font.Color = RGB(40, 101, 156)
        .Font.Bold = True
        .Font.Size = 9
        .Font.Name = "Calibri"
        .NumberFormat = "0.00"
    End With
    
    Application.Calculation = tmpCalc 'Restore setting saved earlier
End Sub