Szybszy sposób korzystania z Sumifs ()

Question

Mam cotygodniowe zadanie, w którym muszę aktualizować raport (obecnie nieco ponad 50 000 wierszy), który co tydzień rośnie o około 500 wierszy. Po ręcznym dodaniu nowych danych uruchamiam poniższy kod, Sumifs()aby podsumować dane.

Struktura danych jest następująca: kolumny od A do C to kolumny kryteriów (numeryczno-alfanumeryczne), kolumna D zawiera ilość do zsumowania (liczby całkowite). Dane są ciągłe. Moje makro umieszcza Sumifs()formułę w kolumnie E - nadpisując to, co tam jest.

Moje pytanie brzmi: czy to zadanie można wykonać szybciej? Obecnie uruchomienie makra zajmuje mi nieco ponad minutę, ale wraz ze wzrostem danych trwa to dłużej.

Na tej stronie jest wiele na temat używania tablic do szybszego wykonywania zadań, ale żaden z przykładów nie ma dla mnie sensu i wolałbym ich nie używać, jeśli to możliwe.

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

Answer 1

Oto inny sposób:

EDYCJA - zaktualizowano w celu dodania „średnich” i „sumifów” do mojej początkowej (błędnej) wersji „countifs” ...

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

Answer 2

@ RuthMac77 powinieneś posłuchać rady Chris'a Neilsena i poszukać w SO możliwych rozwiązań dotyczących macierzy lub poszukać w Google samouczków dotyczących tablic - jest tam wiele.

Powiedziawszy to, odpowiedziałem na bardzo podobne pytanie do tego kilka lat temu tutaj . Korzystając z twojego opisu, zreplikowałem strukturę danych, tak jak ją opisałeś, z 50 000 wierszami danych. Testowanie go przy użyciu istniejącego kodu zajęło około 55 sekund.

Korzystając z opisanej poniżej metody concatenate / sort / IF, obliczenie tych samych danych zajęło zaledwie 1,5 sekundy. Skopiuj kod do swojego modułu i daj mi znać, jak sobie z tym poradzisz.

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