VBA - 具有条件的Summing Array列 - 与excel sumif一样

时间：2013-10-03 09:56:07

标签： arrays vba for-loop multidimensional-array while-loop

我想根据几个条件在数组中总结一个列。 如果数据在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。

3 个答案:

答案 0 :(得分：5)

只是对速度的一个小警告！

我认为问题是 2D数组而不是 excel.range ，因为excel范围上的循环非常懒散（仅当您有一个循环时才有效）很多数据，但我敢打赌，如果您计划使用VBA宏，这是通常的情况;-)）

之前我发现有一些链接报告了这个问题，我已经受到了范围的缓慢的影响（对于10000个单元格的示例，一个用户使用2D数组报告9,7seg与0,16 seg !!）。链接如下。我的建议是始终使用2D数组，简单，干净，快速！

在以下位置查看更多性能测试：

因此，如果你想处理大量数据，Jakub的回复代码应该稍微改变一下，以获得 2D数组的 power ：

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的速度提示。希望你喜欢！

答案 1 :(得分：3)

您可以使用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)

答案 2 :(得分：1)

好的，你说你有一个2D数组（不是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)形式（此数组形式更简单）如果使用arr=range("A1:D5")复制excel范围。 

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.

希望对您的问题有所帮助。

此致，Andres

** 注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位置。

相关问题
最新问题