如何在 Excel 中的数组上使用 VBA 执行 SumIf
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/12975530/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
How to perform SumIf using VBA on an array in Excel
提问by rohrl77
I'm trying to come up with the fastest way to perform a SumIf function in Excel on a dataset that has approx. 110'000 lines. I've come up with three ways, but none of them are satisfying.
我试图想出最快的方法在 Excel 中对大约有一个数据集的数据集执行 SumIf 函数。110'000 行。我想出了三种方法，但没有一种方法令人满意。
Here the first one I tried: Execution time on my PC 100 seconds!
这是我尝试的第一个：PC 上的执行时间 100 秒！
Sub Test1_WorksheetFunction()
Dim MaxRow As Long, MaxCol As Long
Dim i As Long
Dim StartTimer, EndTimer, UsedTime
StartTimer = Now()
With wsTest
MaxRow = .UsedRange.Rows.Count
MaxCol = .UsedRange.Columns.Count
For i = 2 To MaxRow
.Cells(i, 4) = WorksheetFunction.SumIf(wsData.Range("G2:G108840"), .Cells(i, 1), wsData.Range("R2:R108840"))
Next i
End With
EndTimer = Now()
MsgBox (DateDiff("s", StartTimer, EndTimer))
End Sub
Here is the second Method: Execution Time a bit better at 55 seconds
这是第二种方法：执行时间在 55 秒时好一点
Sub Test2_Formula_and_Copy()
Dim MaxRow As Long, MaxCol As Long
Dim i As Long
Dim StartTimer, EndTimer, UsedTime
StartTimer = Now()
With wsTest
MaxRow = .UsedRange.Rows.Count
MaxCol = .UsedRange.Columns.Count
Range("D2").Select
ActiveCell.FormulaR1C1 = _
"=SUMIF(Tabelle1[KUNDENBESTELLNR],Test!RC[-3],Tabelle1[ANZAHL NACHFRAGE])"
Range("D2").Select
Selection.AutoFill Destination:=Range("D2:D6285")
Range("D2:D6285").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End With
EndTimer = Now()
MsgBox (DateDiff("s", StartTimer, EndTimer))
End Sub
Third attempt: Execution so slow it never finished.
第三次尝试：执行速度如此之慢以至于从未完成。
Sub Test3_Read_in_Array()
Dim MaxRow As Long, MaxCol As Long
Dim SearchRange() As String, SumRange() As Long
Dim i As Long, j As Long, k
Dim StartTimer, EndTimer, UsedTime
Dim TempValue
StartTimer = Now()
With wsData
MaxRow = .UsedRange.Rows.Count
ReDim SearchRange(1 To MaxRow)
ReDim SumRange(1 To MaxRow)
For i = 1 To MaxRow
SearchRange(i) = .Range("G" & (1 + i)).Value
SumRange(i) = .Range("R" & (1 + i)).Value
Next i
End With
With wsTest
MaxRow = .UsedRange.Rows.Count
For i = 2 To MaxRow
For j = LBound(SearchRange) To UBound(SearchRange)
k = .Cells(i, 1).Value
If k = SearchRange(j) Then
TempValue = TempValue + SumRange(j)
End If
Next j
.Cells(i, 4) = TempValue
Next i
End With
EndTimer = Now()
MsgBox (DateDiff("s", StartTimer, EndTimer))
End Sub
Clearly I have not yet mastered VBA (or any other programming language for that matter). Can someone help me in getting this to be efficient? There must be a way! Right?
显然我还没有掌握 VBA（或任何其他与此相关的编程语言）。有人可以帮助我提高效率吗？一定有办法！对？
Thanks!
谢谢！
回答by kevin9999
I'd been searching for a faster method for calculating Sumifs for some time when I came up with the following solution. Instead of using Sumifs, you concatenate the values used in the criteria ranges as a single value, then using simple If formulas – combined with one range Sort – you achieve the same results as if you'd used Sumifs.
当我想出以下解决方案时，我一直在寻找一种更快的方法来计算 Sumifs 一段时间。您不使用 Sumifs，而是将标准范围中使用的值作为单个值连接起来，然后使用简单的 If 公式（结合一个范围排序）可以获得与使用 Sumifs 相同的结果。
In my own case, using Sumifs with 25K rows and 2 criteria ranges to evaluate was taking 18.4 seconds on average – using the If and Sort method, it was taking 0.67 seconds on average.
在我自己的案例中，使用包含 25K 行和 2 个条件范围的 Sumifs 进行评估平均需要 18.4 秒——使用 If 和 Sort 方法，平均需要 0.67 秒。
Sub FasterThanSumifs()
'FasterThanSumifs Concatenates the criteria values from columns A and B -
'then uses simple IF formulas (plus 1 sort) to get the same result as a sumifs formula
'Columns A & B contain the criteria ranges, column C is the range to sum
'NOTE: The data is already sorted on columns A AND B
'Concatenate the 2 values as 1 - can be used to concatenate any number of values
With Range("D2:D25001")
.FormulaR1C1 = "=RC[-3]&RC[-2]"
.Value = .Value
End With
'If formula sums the range-to-sum where the values are the same
With Range("E2:E25001")
.FormulaR1C1 = "=IF(RC[-1]=R[-1]C[-1],RC[-2]+R[-1]C,RC[-2])"
.Value = .Value
End With
'Sort the range of returned values to place the largest values above the lower ones
Range("A1:E25001").Sort Key1:=Range("D1"), Order1:=xlAscending, _
Key2:=Range("E1"), Order2:=xlDescending, Header:=xlYes
Sheet1.Sort.SortFields.Clear
'If formula returns the maximum value for each concatenated value match &
'is therefore the equivalent of using a Sumifs formula
With Range("F2:F25001")
.FormulaR1C1 = "=IF(RC[-2]=R[-1]C[-2],R[-1]C,RC[-1])"
.Value = .Value
End With
End Sub
回答by SWa
Give this a whirl
试一试
Sub test()
StartTimer = Now()
With ActiveSheet.Range("D2:D6285")
.FormulaR1C1 = "=SUMIF(Tabelle1[KUNDENBESTELLNR],Test!RC[-3],Tabelle1[ANZAHL NACHFRAGE])"
.Value = .Value
End With
EndTimer = Now()
MsgBox (DateDiff("s", StartTimer, EndTimer))
End Sub
回答by amxy
My version was inspired by kevin999's solution.
我的版本灵感来自 kevin999 的解决方案。
++ works with unsorted sumif criteria
++ will bring the rows back to the original order
++ 使用未排序的 sumif 条件
++ 将行恢复到原始顺序
-- doesn't support multiple criteria columns
-- 不支持多条件列
Please note: The columns containing the criteria and the data to sum up must be one next to another.
请注意：包含条件的列和要汇总的数据必须相邻。
Option Explicit
Sub Execute()
Call FasterThanSumifs(1)
End Sub
Private Sub FasterThanSumifs(Criteria As Long)
'Expects two coloumns next to each other:
'SumIf criteria (left side)
'SumIf data range (right side)
Dim SumRange, DataNumber, HelpColumn, SumifColumn, LastRow As Long
SumRange = Criteria + 1
DataNumber = Criteria + 2
HelpColumn = Criteria + 3
SumifColumn = Criteria + 4
LastRow = UF_LetzteZeile()
Columns(DataNumber).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns(HelpColumn).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns(SumifColumn).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
'Remember data order
Cells(2, DataNumber).Value = 1
Cells(2, DataNumber).AutoFill Destination:=Range(Cells(2, DataNumber), Cells(LastRow, DataNumber)), Type:=xlFillSeries
'Sort the range of returned values to place the largest values above the lower ones
Range(Cells(1, Criteria), Cells(LastRow, SumifColumn)).Sort Key1:=Columns(Criteria), Order1:=xlAscending, Header:=xlYes
ActiveSheet.Sort.SortFields.Clear
'If formula sums the range-to-sum where the values are the same
With Range(Cells(2, HelpColumn), Cells(LastRow, HelpColumn))
.FormulaR1C1 = "=IF(RC[-3]=R[-1]C[-3], RC[-2] + R[-1]C,RC[-2])"
'.Value = .Value
End With
'If formula returns the maximum value for each concatenated value match &
'is therefore the equivalent of using a Sumifs formula
With Range(Cells(2, SumifColumn), Cells(LastRow, SumifColumn))
.FormulaR1C1 = "=IF(RC[-4]=R[+1]C[-4], R[+1]C, RC[-1])"
.Value = .Value
End With
Columns(HelpColumn).Delete
'Sort the range in the original order
Range(Cells(1, Criteria), Cells(LastRow, SumifColumn)).Sort Key1:=Columns(DataNumber), Order1:=xlAscending, Header:=xlYes
ActiveSheet.Sort.SortFields.Clear
Columns(DataNumber).Delete
End Sub
