Faster way of using Sumifs()

问题

I have a weekly task where I need to update a report (currently just over 50K rows) which is growing by around 500 rows every week. After the new data is added manually, I run the code below to do a Sumifs() to summarize the data.

The data structure is: columns A to C are the criteria columns (numeric-alpha-numeric), column D has the quantity to sum (whole numbers). The data is contiguous. My macro puts the Sumifs() formula into column E – overwriting what’s there.

My question is: can this task be done quicker? It currently takes me just over a minute to run the macro, but this gets longer as the data grows.

There’s a lot on this site about using Arrays to do tasks more quickly, but none of the examples make much sense to me and I would prefer not to use them if possible.

Sub MySumIfs()
Dim LastRow As Long

LastRow = Sheet1.Range("A1").End(xlDown).Row

With Sheet1.Range("E2:E" & LastRow)
    .FormulaR1C1 = "=sumifs(R2C4:R" & LastRow & "C4, R2C1:R" & LastRow & "C1, RC1, R2C2:R" & LastRow & "C2, RC2, R2C3:R" & LastRow & "C3, RC3)"
    .Value = .Value
End With

End Sub

回答1:

Here's another way:

EDIT - updated to add "averageifs" and "sumifs" to my initial (mistaken) "countifs" version...

Sub SetupDummyData()
    Const NUM As Long = 100001
    Range("A1:E1").Value = Array("A_Header", "B_Header", "C_Header", "Value", "ResultHere")
    Range("A2:A" & NUM).Formula = "=""A#"" & round(RAND()*10,0)"
    Range("B2:B" & NUM).Formula = "=""B#"" & round(RAND()*10,0)"
    Range("C2:C" & NUM).Formula = "=""C#"" & round(RAND()*10,0)"
    Range("D2:D" & NUM).Formula = "=round(RAND()*100,1)"
    
    Range("A2:D" & NUM).Value = Range("A2:D" & NUM).Value
End Sub


Sub Tester()
    
    Dim arr, ws, rng As Range, keyCols, valueCol As Long, destCol As Long, i As Long, frm As String, sep As String
    Dim t, dict, arrOut(), arrValues(), v, tmp, n As Long
    
    keyCols = Array(1, 2, 3)  'these columns form the composite key
    valueCol = 4              'column with values (for sum)
    destCol = 5               'destination for calculated values
    
    t = Timer
    
    Set ws = ActiveSheet
    Set rng = ws.Range("A1").CurrentRegion
    n = rng.Rows.Count - 1
    Set rng = rng.Offset(1, 0).Resize(n) 'exclude headers
    
    'build the formula to create the row "key"
    For i = 0 To UBound(keyCols)
        frm = frm & sep & rng.Columns(keyCols(i)).Address
        sep = "&""|""&"
    Next i
    arr = ws.Evaluate(frm)  'get an array of composite keys by evaluating the formula
    arrValues = rng.Columns(valueCol).Value  'values to be summed
    ReDim arrOut(1 To n, 1 To 1)             'this is for the results
    
    Set dict = CreateObject("scripting.dictionary")
    'first loop over the array counts the keys
    For i = 1 To n
        v = arr(i, 1)
        If Not dict.exists(v) Then dict(v) = Array(0, 0) 'count, sum
        tmp = dict(v) 'can't modify an array stored in a dictionary - pull it out first
        tmp(0) = tmp(0) + 1                 'increment count
        tmp(1) = tmp(1) + arrValues(i, 1)   'increment sum
        dict(v) = tmp                       'return the modified array
    Next i
    
    'second loop populates the output array from the dictionary
    For i = 1 To n
        arrOut(i, 1) = dict(arr(i, 1))(1)                       'sumifs
        'arrOut(i, 1) = dict(arr(i, 1))(0)                      'countifs
        'arrOut(i, 1) = dict(arr(i, 1))(1) / dict(arr(i, 1))(0) 'averageifs
    Next i
    'populate the results
    rng.Columns(destCol).Value = arrOut
    
    Debug.Print "Checked " & n & " rows in " & Timer - t & " secs"

End Sub

回答2:

@RuthMac77 you should listen to chris neilsen’s advice and search SO for possible array solutions, or alternatively do a Google search for array tutorials – there’s plenty out there.

Having said that, I answered a very similar question to this one a few years ago here. Using your description, I replicated the data structure as you described it with 50, 000 rows of data. Testing it using your existing code took around 55 seconds.

By using the concatenate/sort/IF method outlined below, the same data took just 1.5 seconds to calculate. Copy the code into your module and let me know how you go with it.

Option Explicit
Sub FasterThanSumIfs()
Application.ScreenUpdating = False

Dim LastRow As Long
LastRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row

'Step 1: Concatenate the 3 values to a single string then sort by that string
With Sheet1.Range("E2:E" & LastRow)
    .FormulaR1C1 = "=(RC1 & CHAR(32) & RC2 & CHAR(32) & RC3)"
    .Value = .Value
End With
Sheet1.Columns("A:E").Sort Key1:=Sheet1.Range("E2"), Order1:=xlAscending, Header:=xlYes
Sheet1.Sort.SortFields.Clear

'Step 2: calculate the sum range column where the concatenated values are the same
With Sheet1.Range("F2:F" & LastRow)
    .FormulaR1C1 = "=IF(RC5=R[-1]C5,RC4+R[-1]C6,RC4)"
    .Value = .Value
End With

'Step 3: sort by string then by summed values largest to smallest to
'place the largest values at the top of each concatenated values' 'list'
Sheet1.Columns("A:F").Sort Key1:=Range("E2"), Order1:=xlAscending, _
Key2:=Range("F2"), Order2:=xlDescending, Header:=xlYes
Sheet1.Sort.SortFields.Clear

'Step 4: Return the highest value for each concatenated string
With Sheet1.Range("G2:G" & LastRow)
    .FormulaR1C1 = "=IF(RC5=R[-1]C5,R[-1]C7,RC6)"
    .Value = .Value
End With

'Step 5: replace the concatenated string values in column E with
'the Sumifs() values from column G.  Column E now contains the correct Sumifs()
'values as if a Sumifs() formula had been used - only much quicker!

Sheet1.Range("G2:G" & LastRow).Copy Sheet1.Range("E2")
Sheet1.Range("F:G").Clear

Application.ScreenUpdating = True
End Sub

来源：https://stackoverflow.com/questions/64939776/faster-way-of-using-sumifs

标签

arrays

excel

vba

sumifs