如何在Excel中的数组上使用VBA执行SumIf

Question

我正在尝试用最快的方法在Excel中对具有大约的数据集执行SumIf函数.110'000行.我想出了三种方法,但没有一种方法令人满意.

这是我试过的第一个:在我的电脑上执行时间100秒!

    Sub Test1_WorksheetFunction()

Dim MaxRow As Long, MaxCol As Long
Dim i As Long
Dim StartTimer, EndTimer, UsedTime

StartTimer = Now()

With wsTest
    MaxRow = .UsedRange.Rows.Count
    MaxCol = .UsedRange.Columns.Count

    For i = 2 To MaxRow
        .Cells(i, 4) = WorksheetFunction.SumIf(wsData.Range("G2:G108840"), .Cells(i, 1), wsData.Range("R2:R108840"))
    Next i

End With

EndTimer = Now()
MsgBox (DateDiff("s", StartTimer, EndTimer))

End Sub

这是第二种方法:执行时间在55秒时好一点

Sub Test2_Formula_and_Copy()

Dim MaxRow As Long, MaxCol As Long
Dim i As Long
Dim StartTimer, EndTimer, UsedTime

StartTimer = Now()

With wsTest
    MaxRow = .UsedRange.Rows.Count
    MaxCol = .UsedRange.Columns.Count

    Range("D2").Select
    ActiveCell.FormulaR1C1 = _
        "=SUMIF(Tabelle1[KUNDENBESTELLNR],Test!RC[-3],Tabelle1[ANZAHL NACHFRAGE])"
    Range("D2").Select
    Selection.AutoFill Destination:=Range("D2:D6285")
    Range("D2:D6285").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

End With

EndTimer = Now()
MsgBox (DateDiff("s", StartTimer, EndTimer))

End Sub

第三次尝试:执行速度太慢,从未完成.

Sub Test3_Read_in_Array()

Dim MaxRow As Long, MaxCol As Long
Dim SearchRange() As String, SumRange() As Long
Dim i As Long, j As Long, k
Dim StartTimer, EndTimer, UsedTime
Dim TempValue

StartTimer = Now()

With wsData
    MaxRow = .UsedRange.Rows.Count
    ReDim SearchRange(1 To MaxRow)
    ReDim SumRange(1 To MaxRow)
    For i = 1 To MaxRow
        SearchRange(i) = .Range("G" & (1 + i)).Value
        SumRange(i) = .Range("R" & (1 + i)).Value
    Next i
End With

With wsTest
    MaxRow = .UsedRange.Rows.Count
    For i = 2 To MaxRow
        For j = LBound(SearchRange) To UBound(SearchRange)
            k = .Cells(i, 1).Value
            If k = SearchRange(j) Then
            TempValue = TempValue + SumRange(j)
            End If
        Next j
        .Cells(i, 4) = TempValue
    Next i
End With


EndTimer = Now()
MsgBox (DateDiff("s", StartTimer, EndTimer))

End Sub

显然,我还没有掌握VBA(或任何其他编程语言).有人可以帮助我提高效率吗？一定有办法!对？

谢谢!

Answer 1

当我提出以下解决方案时,我一直在寻找一种更快的方法来计算Sumifs.您不是使用Sumifs,而是将条件范围中使用的值连接为单个值,然后使用简单的If公式 - 结合一个范围排序 - 您可以获得与使用Sumifs相同的结果.

在我自己的情况下,使用具有25K行和2个标准范围的Sumifs进行评估平均需要18.4秒 - 使用If和Sort方法,平均需要0.67秒.

 Sub FasterThanSumifs()
    'FasterThanSumifs Concatenates the criteria values from columns A and B -
    'then uses simple IF formulas (plus 1 sort) to get the same result as a sumifs formula

    'Columns A & B contain the criteria ranges, column C is the range to sum
    'NOTE: The data is already sorted on columns A AND B

    'Concatenate the 2 values as 1 - can be used to concatenate any number of values
    With Range("D2:D25001")
        .FormulaR1C1 = "=RC[-3]&RC[-2]"
        .Value = .Value
    End With

    'If formula sums the range-to-sum where the values are the same
    With Range("E2:E25001")
        .FormulaR1C1 = "=IF(RC[-1]=R[-1]C[-1],RC[-2]+R[-1]C,RC[-2])"
        .Value = .Value
    End With

    'Sort the range of returned values to place the largest values above the lower ones
    Range("A1:E25001").Sort Key1:=Range("D1"), Order1:=xlAscending, _
    Key2:=Range("E1"), Order2:=xlDescending, Header:=xlYes
    Sheet1.Sort.SortFields.Clear

    'If formula returns the maximum value for each concatenated value match &
    'is therefore the equivalent of using a Sumifs formula
    With Range("F2:F25001")
        .FormulaR1C1 = "=IF(RC[-2]=R[-1]C[-2],R[-1]C,RC[-1])"
        .Value = .Value
    End With

    End Sub