我想根据几个条件对数组中的一列求和。如果数据在 Excel 中，我会使用=SUMIFS公式。
我拥有的二维数组中的示例数据集是：
ID1 ID2 ID3 Value
0 1 1 4
0 2 2 5
1 3 2 6
0 1 1 3
0 1 0 2
我想根据以下条件对值列求和：
ID1=0
ID2=1
ID3=1
因此第 1 行和第 4 行符合此标准，因此答案将是 7 (4+3)
我将如何在 VBA 中构建它。
请注意，ID 可能是无限的，它们也可能是字符串，因此我无法ID=0在循环中设置。
只是速度上的一个小警告！
我相信问题是针对二维数组而不是针对excel.range，因为 excel 范围上的循环非常缓慢（仅当您有大量数据时才有效，但我敢打赌，如果您打算使用一个 VBA 宏 ;-) )
在我发现一些报告此问题的链接之前，我一直遭受范围缓慢的困扰（例如，有 10000 个单元格，一个用户使用 2D 数组报告 9,7seg 与 0,16 seg ！！）。链接如下。我的建议是始终使用 2D 数组，简单、干净、快速！
在以下位置查看更多性能测试：
因此，如果要处理大量数据，Jakub 回复的代码应该稍作改动，以获得2D数组的威力：
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
使用方式与 Jakub 在回复中显示的方式相同：
debug.Print sumIfMultipleConditionsMet2(Range("A1:D50000"), 0, 1, 1)
希望你喜欢！
问候， 安德烈斯
PS：如果你想走得更远，这里有更多关于excel的速度提示。希望你喜欢！
您可以使用 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
然后你可以像这样使用它：
debug.Print sumIfMultipleConditionsMet(Range("A1:D5"), 0, 1, 1)
好的，你说你有一个二维数组（不是 excel 范围），但没有指定数组的确切形状。所以我必须假设你的二维数组被称为“arr”并且具有以下形式：arr(c,r) as variant，其中r用于访问行和c列（1代表“ID1”，2代表“ID2”，3代表“ID3”和4 代表“价值”）。（如果您不遵循这个想法，请参阅“注释 1”和“注释 2”以获得进一步说明）。
然后你只需要做一个小循环：
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
该tot变量将包含您尝试计算的总数。简单的？？
如果要在函数中扭曲前一个，可以使用：
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
像这样使用它：Debug.Print SumIfMyArray(YouArr, 1, 1, 1). 希望这可以帮助。
更复杂（但更灵活）：
现在，如果你想拥有一个非常通用的函数来支持不同的标准，同时对列保持灵活，你可以使用下面的代码（注意，我在其他回复中使用 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
有点棘手，但更灵活。您可以将其与范围一起使用：
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.
希望这对您的问题有所帮助。
问候， 安德烈斯
**注意 1 ** 当数组形式为 时，arr(c,r)您可以通过在括号内给出坐标来访问任何元素。例如，如果您想访问第 2 行第 4 列的值，您必须编写代码arr(4,2)并且您将获得 5 的值（前提是您正在测试您的问题的相同示例。在您的第一个表中检查它）。
**注意 2 ** 我有理由arr(c,r)使用arr(r,c). redim原因是因为如果您在最后一个位置有行坐标，那么如果您想使用指令添加更多行会更容易。但是，如果您的 2D 数组来自 excel 范围（例如使用类似的东西arr = range("A3:D6").value），那么最好在代码中翻转 r 和 c 位置。