VBA - 带条件的求和数组列 - 就像 excel sumif
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/19156144/
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
VBA - Summing Array column with conditions - Like excel sumif
提问by Mark
I would like to sum a columnin an array based on several conditions.
If the data were in Excel I would use a =SUMIFSformula.
我想根据几个条件对数组中的一列求和。如果数据在 Excel 中，我会使用=SUMIFS公式。
The sample dataset in a 2 dimensional array I have is:
我拥有的二维数组中的示例数据集是：
ID1 ID2 ID3 Value
0 1 1 4
0 2 2 5
1 3 2 6
0 1 1 3
0 1 0 2
I would like to sum the value column based on the following conditions:
我想根据以下条件对值列求和：
ID1=0
ID2=1
ID3=1
Therefore rows 1 and 4 meet this criteria and hence the answer would be 7 (4+3)
因此，第 1 行和第 4 行符合此标准，因此答案为 7 (4+3)
How Would I construct this in VBA.
我将如何在 VBA 中构建它。
Note that the ID's may be infinite and they may be strings either so I can'tset ID=0in the loop.
请注意，ID 可能是无限的，也可能是字符串，因此我无法ID=0在循环中进行设置。
回答by A.Sommerh
Just a small warning on the speed!
只是一个关于速度的小警告！
I believe the question is for a 2D arrayand not for a excel.rangebecause a loop on an excel range is very sloooooowly (valid only if you have a lot of data, but I bet that is the usual case if you plan to use a VBA macro ;-) )
我相信问题是针对2D 数组而不是针对excel.range 的，因为 excel 范围上的循环非常慢（仅当您有大量数据时才有效，但我敢打赌，如果您打算使用，这是通常的情况VBA 宏 ;-) )
I have suffer from the slowness of the range before until I found a few links reporting this issue (For an example with 10000 cells, one user reports 9,7seg vs. 0,16 seg using the 2D array!!). The links are below. My recommendation is to use always 2D array, simple, clean and fast!
在我发现一些报告此问题的链接之前，我一直受到范围缓慢的困扰（例如，有 10000 个单元格，一位用户使用 2D 数组报告 9,7seg 与 0,16 seg ！！）。链接如下。我的建议是始终使用二维数组，简单、干净、快速！
See more performance tests in:
查看更多性能测试：
- http://dailydoseofexcel.com/archives/2006/12/04/writing-to-a-range-using-vba/
- http://blogs.office.com/b/microsoft-excel/archive/2008/10/03/what-is-the-fastest-way-to-scan-a-large-range-in-excel.aspx
- http://dailydoseofexcel.com/archives/2006/12/04/writing-to-a-range-using-vba/
- http://blogs.office.com/b/microsoft-excel/archive/2008/10/03/what-is-the-fastest-way-to-scan-a-large-range-in-excel.aspx
Therefore, if you want to process a lot of data, the code of Jakub's reply should changed just a bit, in order the gain the powerof the 2D array:
因此，如果你要处理大量的数据，的Jakub答复的代码应该改变只是有点，为了增益的电源的的二维数组：
Public Function sumIfMultipleConditionsMet2(rng As Range, ParamArray conditions() As Variant) As Double
Dim conditionCount As Long: conditionCount = UBound(conditions) + 1
Dim summedColumnIndex As Long: summedColumnIndex = conditionCount + 1
Dim currentRow As Range
Dim result As Double: result = 0 'Changed from Long to Double
Dim i As Long
If rng.Columns.Count <> conditionCount + 1 Then
Err.Raise 17, , "Invalid range passed"
End If
Dim conditionsMet As Boolean
'USING AN ARRAY INSTEAD OF A RANGE
Dim arr As Variant
arr = rng.Value 'Copy the range to an array
Dim r As Long
For r = LBound(arr, 1) To UBound(arr, 1) 'OLD: For Each currentRow In rng.Rows
conditionsMet = True
For i = LBound(conditions) To UBound(conditions)
' cells collection is indexed from 1, the array from 0
' OLD: conditionsMet = conditionsMet And (currentRow.Cells(1, i + 1).Value = conditions(i))
conditionsMet = conditionsMet And (arr(r, i + 1) = conditions(i))
Next i
If conditionsMet Then
'OLD: result = result + currentRow.Cells(1, summedColumnIndex).Value
result = result + arr(r, summedColumnIndex)
End If
Next r
sumIfMultipleConditionsMet2 = result
End Function
Use it the same way that Jakub showed in his reply:
使用与 Jakub 在他的回复中显示的相同的方式：
debug.Print sumIfMultipleConditionsMet2(Range("A1:D50000"), 0, 1, 1)
Hope you like it!
希望你喜欢！
Regards, Andres
问候， 安德烈斯
PS: If you want to go further, here are more speed tips for excel. Hope you like it!
PS：如果你想更进一步，这里有更多excel的速度技巧。希望你喜欢！
- http://www.avdf.com/apr98/art_ot003.html//See tip#1 - good info on writing fast VBA code for Excel.
- http://blogs.msdn.com/excel/archive/2009/03/12/excel-vba-performance-coding-best-practices.aspx- fast coding
- http://support.microsoft.com/kb/153090/en-us- pass an Excel array to VB
- http://support.microsoft.com/kb/177991- some limitations when passing arrays to sheets (excel 2000 a bit old!)
- http://www.avdf.com/apr98/art_ot003.html//请参阅提示#1 - 有关为 Excel 编写快速 VBA 代码的好信息。
- http://blogs.msdn.com/excel/archive/2009/03/12/excel-vba-performance-coding-best-practices.aspx- 快速编码
- http://support.microsoft.com/kb/153090/en-us- 将 Excel 数组传递给 VB
- http://support.microsoft.com/kb/177991- 将数组传递给工作表时的一些限制（excel 2000 有点旧！）
回答by Apokralipsa
You could use the paramArray feature to get a more generalized version of the sumif function. For example:
您可以使用 paramArray 功能来获得 sumif 函数的更通用版本。例如：
Public Function sumIfMultipleConditionsMet(rng As range, ParamArray conditions() As Variant) As Long
Dim conditionCount As Long: conditionCount = UBound(conditions) + 1
Dim summedColumnIndex As Long: summedColumnIndex = conditionCount + 1
Dim currentRow As range
Dim result As Long: result = 0
Dim i As Long
If rng.Columns.Count <> conditionCount + 1 Then
Err.Raise 17, , "Invalid range passed"
End If
Dim conditionsMet As Boolean
For Each currentRow In rng.Rows
conditionsMet = True
For i = LBound(conditions) To UBound(conditions)
' cells collection is indexed from 1, the array from 0
conditionsMet = conditionsMet And (currentRow.Cells(1, i + 1).Value = conditions(i))
Next i
If conditionsMet Then
result = result + currentRow.Cells(1, summedColumnIndex).Value
End If
Next
sumIfMultipleConditionsMet = result
End Function
Then you could use it like this:
然后你可以像这样使用它：
debug.Print sumIfMultipleConditionsMet(Range("A1:D5"), 0, 1, 1)
回答by A.Sommerh
OK, you said you have a 2D array (not an excel range), but the exact shape of the array was not specificated. So I have to assume your 2D array is call "arr" and has the form of: arr(c,r) as variant, where ris used for accessing the rows and cfor the columns (1 for "ID1", 2 for "ID2", 3 for "ID3" and 4 for "Value"). (See "note 1" and "note 2" for further clarification if you are not following the idea).
好的，你说你有一个二维数组（不是一个 excel 范围），但没有指定数组的确切形状。所以我必须假设你的二维数组被称为“arr”并且具有以下形式：arr(c,r) as variant，其中r用于访问行和c列（1 表示“ID1”，2 表示“ID2”，3 表示“ID3”和4 表示“价值”）。（如果您不遵循该想法，请参阅“注释 1”和“注释 2”以获得进一步说明）。
Then you just have to make a small loop:
然后你只需要做一个小循环：
tot = 0
For i = LBound(arr, 2) To UBound(arr, 2) ' The "2" in the second paramenter is
' for getting the lower and upper bound
' of the "2nd" dimention of the array
If arr(1, i) = A And arr(2, i) = B And arr(3, i) = C Then
tot = tot + arr(4, i)
End If
Next i
The totvariable will have the total you was trying to calculate. Easy??
该tot变量将包含您试图计算的总数。简单？？
If you want to warp the previous in a function, you can use:
如果要扭曲函数中的前一个，可以使用：
Public Function SumIfMyArray(arr As Variant, A As Variant, _
B As Variant, C As Variant) As Double
Dim i as Long
Dim tot As Double
tot = 0
For i = LBound(arr, 2) To UBound(arr, 2)
If arr(1, i) = A And arr(2, i) = B And arr(3, i) = C Then
tot = tot + arr(4, i) 'Adding the filtered value
End If
Next i
SumIfMyArray = tot 'Returning the calculated sum
End Function
Use it like: Debug.Print SumIfMyArray(YouArr, 1, 1, 1). Hope this helps.
使用它，如：Debug.Print SumIfMyArray(YouArr, 1, 1, 1)。希望这可以帮助。
MORE COMPLEX (BUT FLEXIBLE):
更复杂（但灵活）：
Now, if you want to have a very generic function that support different criterias and at the same time to be flexible with the columns, you can use the code below (Note, I'm using the ParamArray like in other reply). Actually the function can use an array in the form arr(c,r)(that array form is easier to adding more rows with rediminstruction) and the second in the form arr(r,c)(this array form is simpler if you copy an excel range using arr=range("A1:D5")).
现在，如果您想要一个非常通用的函数来支持不同的标准，同时又可以灵活地处理列，您可以使用下面的代码（注意，我正在使用 ParamArray，就像在其他回复中一样）。实际上，该函数可以使用表单arr(c,r)中的数组（该数组形式更容易通过redim指令添加更多行）和表单中的第二个arr(r,c)（如果您使用 复制 excel 范围，则此数组形式更简单arr=range("A1:D5")）。
Private Function SumIfConditionsMetArray(ColToAdd As Long, Arr As Variant, _
TypeArrayIsRC As Boolean, _
ParamArray Criteria() As Variant) As Double
' Returns: The sum of values from a column where
' the row match the criteria.
' Parameters:
' 1) Arr: An array in the form of arr(row,col) (
' (like the array passed by an excel range)
' 2) ColToAdd: Index of column you want to add.
' 3) TypeArrayIsRC: 'True' if the array passed if in the
' form of arr(Row,Column) or 'False' if
' the array is in the form arr(Column,Row).
' Note that passing an range as
' arr=range("A1:B3").value , then "true"
' should be used!
' 4) Criteria: a list of criteria you want to use for
' filtering, if you want to skip a column
' from the criteria use "Null" in the
' parameter list.
'
' Example: Debug.Print SumIfConditionsMetArray(4, data, true, 9, null, 5)
' (It means: sum column 4 of data where 1st column
' match "9" and 3rd column match "5".
' The 2nd column was skipped because of null)
Dim tot As Double
Dim CountCol As Long
Dim r As Long, c As Long
Dim conditionsMet As Boolean
Dim cExtra As Long
Dim DimRow As Long, DimCol As Long
If TypeArrayIsRC Then
DimRow = 1: DimCol = 2
Else
DimRow = 2: DimCol = 1
End If
'Some checking...
If ColToAdd < LBound(Arr, DimCol) Or ColToAdd > UBound(Arr, DimCol) Then
Err.Raise vbError + 9, , "Error in function SumIfConditionsMetArray. ColToAdd is out of the range."
End If
'Correction in case of different array bases..
cExtra = LBound(Arr, DimCol) - LBound(Criteria) 'In case the lower bound were different...
'Limit the last column to check
CountCol = UBound(Criteria)
If CountCol > UBound(Arr, DimCol) - cExtra Then
'Not raising an error, just skip out the extra parameters!
'(Put err.raise if you want an error instead)
CountCol = UBound(Arr, DimCol) - cExtra
End If
On Error GoTo errInFunction
'''' LOOP ''''
Dim A As Long
Dim B As Long
tot = 0
For r = LBound(Arr, DimRow) To UBound(Arr, DimRow)
If TypeArrayIsRC Then
A = r
Else
B = r
End If
conditionsMet = True
For c = LBound(Criteria) To CountCol
If Not IsNull(Criteria(c)) Then
If TypeArrayIsRC Then
B = c + cExtra
Else
A = c + cExtra
End If
If Arr(A, B) <> Criteria(c) Then
conditionsMet = False 'Creteria not met
End If
End If
Next c
If TypeArrayIsRC Then
B = ColToAdd
Else
A = ColToAdd
End If
If conditionsMet Then
tot = tot + Arr(A, B) 'Adding the value
End If
Next r
SumIfConditionsMetArray = tot 'Returning the calculated sum
Exit Function
''' END '''
errInFunction:
Err.Raise Err.Number, , "Error in function SumIfConditionsMetArray. Check the parameters are inside the bounds."
End Function
Is a bit more tricky but much more flexible. You can use it with a range as:
有点棘手，但更灵活。您可以将它与一个范围一起使用：
Dim MyArr as variant
MyArr = ActiveSheet.range("A1:G10").Value ' Note: use ".Value" at end
' and not start with "Set"
Debug.Print SumIfConditionsMetArray(4, MyArr, True, 100, null, 100)
' This will add the value of the 4th column, were the row
' has 100 in the first column and 100 in the 3rd column.
Hoping this help with your question.
希望这对您的问题有所帮助。
Regards, Andres
问候， 安德烈斯
** Note 1** When having an array in the form of arr(c,r)you can access any element by giving the coordinates inside the parenthesis. For example, if you want to access the value of 4th column of the 2nd row, you have to code arr(4,2)and you will get the value of 5 (provided you are testing the same example of your question. Check it in your first table).
**注意 1** 当有一个数组形式时，arr(c,r)您可以通过在括号内给出坐标来访问任何元素。例如，如果您想访问第 2 行第 4 列的值，则必须进行编码arr(4,2)，您将获得值 5（前提是您正在测试问题的相同示例。请在第一个表中检查）。
** Note 2** I have a reason for the arr(c,r)instead of arr(r,c). The reason is because it is much more easier if you want to add more rows with the rediminstruction if you have the row coordinate in a the last position. But if you 2D array is coming from a excel range (Using for example something like arr = range("A3:D6").value), then it will be better to flip the r and c position in the code.
**注意 2** 我有一个理由arr(c,r)代替arr(r,c). 原因是因为如果您redim在最后一个位置有行坐标，那么如果您想使用指令添加更多行，会容易得多。但是，如果您的二维数组来自 excel 范围（例如使用类似arr = range("A3:D6").value），那么最好翻转代码中的 r 和 c 位置。
