Хорошо, вы сказали, что у вас есть двумерный массив (не диапазон Excel), но точная форма массива не была указана. Поэтому я должен предположить, что ваш 2D-массив называется "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), вы можете получить доступ к любому элементу, указав координаты внутри круглых скобок. Например, если вы хотите получить доступ к значению 4-го столбца 2-й строки, вам нужно ввести код arr(4,2), и вы получите значение 5 (при условии, что вы тестируете тот же пример своего вопроса. Проверьте его в своей первой таблице) .
** Примечание 2 ** У меня есть причина для arr(c,r) вместо arr(r,c). Причина в том, что гораздо проще добавить больше строк с помощью инструкции redim, если у вас есть координата строки в последней позиции. Но если ваш 2D-массив исходит из диапазона Excel (используя, например, что-то вроде arr = range("A3:D6").value), то будет лучше перевернуть позиции r и c в коде.
03.10.2013
