VBA SumIfs 太慢答案

【问题标题】：VBA SumIfs Too SlowVBA SumIfs 太慢
【发布时间】：2021-10-26 19:01:40
【问题描述】：

我有一个 WorksheetFunction.SumIfs，其中有 3 个 Args 代码应用于这么多单元格（10k 行 x 20 列），它运行了 2 个小时才能完成，但是当我做同样的事情但在 excel 中使用公式并拖动和下降到最后一列和最后一行，它走得更快（不到 10 分钟）。我已经完成了 xlCalculationManual。您对如何提高 VBA 的处理时间有任何想法吗？

代码：

application.calculation= xlCalculationManual

for Col = 3 to 22
   for Row = 2 to 10000
      FileA.Cells(Row, Col).Value = Application.WorksheetFunction.SumIfs(FileB.Range("A:A"), FileB.Range("D:D"), FileA.Range("A" & Row).Value, FileB.Range("B:B"), FileA.Range("B" & Row).Value, FileB.Range("C:C"), FileA.Cells(1, Col).Value)
   Next
Next

解决方案：我自己找到了一个简单的解决方案。在大范围的数据中，不要在 FOR 中使用 Application.WorksheetFunction.FUNCTION_NAME，而是在第一个 Cell 中使用 Book.Sheet.Range().Formula = "=Formula(Parameters)"，然后使用 .Copy，然后使用 .PasteSpecial 粘贴:=xlPasteFormulas，示例如下：

' Takes 2h
for Col = 3 to 22
   for Row = 2 to 10000
      FileA.Cells(Row, Col).Value = Application.WorksheetFunction.SumIfs(FileB.Range("A:A"), FileB.Range("D:D"), FileA.Range("A" & Row).Value, FileB.Range("B:B"), FileA.Range("B" & Row).Value, FileB.Range("C:C"), FileA.Cells(1, Col).Value)
   Next
Next

' Takes 10min
application.calculation= xlCalculationManual

FileA.Cells(2, 3).Formula = "=SUMIFS([FileB.XLSX]Sheet1!$A:$A,[FileB.XLSX]Sheet1!$D:$D,$A2,[FileB.XLSX]Sheet1!$B:$B,$B2,[FileB.XLSX]Sheet1!$C:$C,C$1)"
FileA.Cells(2, 3).Copy
FileA.Range(FileA.Cells(2, 3), FileA.Cells(10000, 22)).PasteSpecial Paste:=xlPasteFormulas

application.calculation= xlCalculationAutomatic

【问题讨论】：

查看此问答。特别是一些答案中提供的application.screenupdating 和application.calculate 设置：How to improve the speed of VBA macro code? 基本上你想在前端关闭excel 的更新，以便它可以尽可能快地遍历你的嵌套for 循环，然后完成后重新打开所有这些功能。
1.将所有完整列限制为仅数据集，您可以在代码的早期动态发现，然后仅使用该范围。 2. 对于其他输入，填充数据数组并迭代这些数据而不是范围。 3. 用输出填充变量数组，然后一次加载范围。
@ScottCraner，我在实践中无法理解你的解决方案，你能用我的代码做一个例子吗？提前致谢
从 1 开始的 col 也没有意义，因为您在同一张纸上指的是 B，但从 A 开始，这不会覆盖您用于 sumif 的值吗？
@ScottCraner，代码只是一个示例，它适用于我的工作，我无法输入真正的代码（有效）

标签： excel vba worksheet-function sumifs

【解决方案1】：

根据我的 cmets，使用变体数组并循环一次范围。

Sub mysumif()
    Dim fileA As Worksheet
    Set fileA = Worksheets("Sheet2")
    
    Dim fileB As Worksheet
    Set fileB = Worksheets("Sheet1")
    
    Dim rngArr As Variant
    rngArr = Intersect(fileB.Range("A:D"), fileB.UsedRange)
    
    Dim Bclm As Variant
    Bclm = Intersect(fileA.Range("A2:B100000"), fileA.UsedRange)
    
    Dim ttlRos As Variant
    ttlRos = Intersect(fileA.Range("C1:ZZ1"), fileA.UsedRange)
    

    
    Dim otptArr As Variant
    ReDim otptArr(1 To UBound(Bclm, 1), 1 To UBound(ttlRos, 2))
    
    Dim i As Long
    For i = 1 To UBound(rngArr, 1)
        Dim j As Variant
        j = Application.Match(rngArr(i, 3), ttlRos, 0)
        
        If Not IsError(j) Then
            Dim k As Long
            For k = 1 To UBound(Bclm, 1)
                If Bclm(k, 1) = rngArr(i, 4) And Bclm(k, 2) = rngArr(i, 2) Then
                    otptArr(k, j) = otptArr(k, j) + rngArr(i, 1)
                    Exit For
                End If
            Next k
        End If
    Next i
    
    fileA.Range("C2").Resize(UBound(otptArr, 1), UBound(otptArr, 2)).Value = otptArr
                
End Sub

之前：

之后：

还要注意，数据透视表也可以更快地做到这一点：

【讨论】：