在Excel中需要根据满足6种不同列中满足标准的值使用VBA获得列的总和

Question

如果其他6列满足单个标准，我需要评估单列的总和。每个列中的每一列都具有值数组。

我尝试了两种给出理想结果的方法，但是它们不符合性能期望，因为我必须平均评估500,000行，并且此逻辑将成为UDF的一部分，这意味着如果此功能在该功能中使用了几次每当Excel重新计算时，都会发射不同的单元。

以下是我的各种方法，我每天都对VBA编码学习非常陌生，我将感谢您对改进以下方法或实现这一目标的全新方法的意见。 样本数据集作为图像附加。 示例数据集

方法1 ：使用自动滤波器以及次序功能以及次序功能总和。这花了12毫秒的12k行。

Worksheets("Data").Range("D2:D9").AutoFilter Field:=4, Criteria1:=period_num_arr, Operator:=xlFilterValues
Worksheets("Data").Range("E2:E9").AutoFilter Field:=5, Criteria1:=segment1_arr, Operator:=xlFilterValues
Worksheets("Data").Range("F2:F9").AutoFilter Field:=6, Criteria1:=segment2_arr, Operator:=xlFilterValues
Worksheets("Data").Range("G2:G9").AutoFilter Field:=7, Criteria1:=segment3_arr, Operator:=xlFilterValues
Worksheets("Data").Range("H2:H9").AutoFilter Field:=6, Criteria1:=segment4_arr, Operator:=xlFilterValues
Worksheets("Data").Range("I2:I9").AutoFilter Field:=7, Criteria1:=segment5_arr, Operator:=xlFilterValues
l_total = Application.WorksheetFunction.Subtotal(9, Worksheets("Data").Range("A2:A9"))
Worksheets("Data").AutoFilterMode = False 'For close to million records this takes 2 secs

方法2 ：调整了我遇到的函数在线参考并修改为将1D数组作为输入。这需要12k行

Private Function SumIfConditionsMetArray(ColToAdd As Long, arr As Variant, _
                       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. In this example this is 1
    ' 3) 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.

    Dim tot As Double
    Dim CountCol As Long, param_array_cnt As Long
    Dim r As Long, c As Long, d As Long
    Dim conditionsMet As Boolean, paramConditionsMet As Boolean
    Dim cExtra As Long
    Dim DimRow As Long, DimCol As Long
    DimRow = 1: DimCol = 2
    cExtra = 4    
    CountCol = UBound(Criteria)
    Dim A As Long
    Dim B As Long
    tot = 0
    For r = LBound(arr, DimRow) To UBound(arr, DimRow)
            A = r
        conditionsMet = False
        For c = LBound(Criteria) To CountCol
            B = c + cExtra            
            If Not IsZeroLengthArray(c) Then 'Custom function to evaluate if the passed Array is empty
                For d = LBound(Criteria(c)) To UBound(Criteria(c))
                    conditionsMet = False
                    paramConditionsMet = False
                    If CStr(arr(A, B)) = CStr(Criteria(c)(d)) Then
                        paramConditionsMet = True
                    End If                
                    If paramConditionsMet Then
                        Exit For
                    End If            
                Next d                
                If paramConditionsMet Then conditionsMet = True                
            End If                
            If Not conditionsMet Then
                Exit For
            End If
        Next c
        B = ColToAdd
        If conditionsMet Then
            tot = tot + arr(A, B) 'Adding the value
        End If
    Next r
    SumIfConditionsMetArray = tot 'Returning the calculated sum
End Function

可能的方法3秒大约需要3秒。以下示例数据的示例

=SUM(SUMIFS(A2:A9,D2:D9,{1,2,4},G2:G9,{"1430","7340"}))

提供了51133.52，而正确的值为52369.68

Answer 1

您几乎在那儿，有很近的地方：

单元格中的公式是：

=SUM(SUMIFS(A2:A9;D2:D9;{1;2;4};G2:G9;{7340\1430}))

唯一的区别是第二个标准：您的是{“ 1430”，“ 7340”}和我的是{“ 1430” \“ 7340”}