脚本的VBA和Excel优化，处理70万行

Question

你好 StackOverflowers，

我目前正在处理一个包含一个嵌套 IF 语句的脚本。运行时，它可能会计算大约 1.4m 的 IF。

我已经使用计时器进行了测试(不太确定 VBA 中计时器的准确性)，并且处理 1000 行给了我 10 秒的时间。 10 * 700 = 7000 秒，即 = 1.94 小时。

在处理如此大的数据集时，谁能给我任何优化提示？

我的代码如下

Sub itS1Capped()
    Dim Start, Finish, TotalTime
    Start = Timer
    Dim c, d, j, lastRow
    c = 1

    'find how many rows
    With Worksheets("Data")
    lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With

    'loop through all rows
    For Each d In Worksheets("Data").Range("D2:D" & lastRow).Cells 'd = IT S0 Uncapped

        j = Worksheets("Data").Range("J" & c + 1).Value  'IT Cap
        If j <> 0 Then

            If d > j Then
                Worksheets("Data").Range("K" & c + 1).Value = j 'IT S1 Capped = j
            Else
                 Worksheets("Data").Range("K" & c + 1).Value = d 'IT S1 Capped = d
            End If
        Else
            Worksheets("Data").Range("K" & c + 1).Value = d 'IT S1 Capped = d
        End If
        c = c + 1
    Next
    Finish = Timer
    TotalTime = Finish - Start
    MsgBox TotalTime
End Sub

Answer 1

所以我从 Mark Moore 对数组的使用中获得灵感，发现使用数组函数而不是在一个范围内复制和粘贴普通函数要快得多。在我的机器上，Mark 的程序在 2.2 秒内运行，下面的程序在 1.4 秒内运行。

Sub FormulaArray()
    Dim iUsedRows As Long, rCell As Range, StartTimer As Double, Duration As Double

    StartTimer = Timer
    iUsedRows = ActiveSheet.UsedRange.Cells(ActiveSheet.UsedRange.Rows.Count, 1).Row

    With Range(Cells(1, 11), Cells(iUsedRows, 11))
        .FormulaArray = "=IF(J:J<>0,IF(D:D>J:J,J:J,D:D),D:D)"
        .Copy
        .PasteSpecial xlPasteValues
    End With

    Duration = StartTimer - Timer
    MsgBox Format(Duration, "#0.0000") & " seconds to run"

End Sub