Schnellere Verwendung von Sumifs ()
Ich habe eine wöchentliche Aufgabe, bei der ich einen Bericht aktualisieren muss (derzeit etwas mehr als 50.000 Zeilen), der jede Woche um etwa 500 Zeilen wächst. Nachdem die neuen Daten manuell hinzugefügt wurden, führe ich den folgenden Code aus, um Sumifs()
die Daten zusammenzufassen.
Die Datenstruktur lautet: Die Spalten A bis C sind die Kriterienspalten (numerisch-alphanumerisch), die Spalte D enthält die zu summierende Menge (ganze Zahlen). Die Daten sind zusammenhängend. Mein Makro fügt die Sumifs()
Formel in Spalte E ein - überschreibt, was da ist.
Meine Frage ist: Kann diese Aufgabe schneller erledigt werden? Derzeit brauche ich etwas mehr als eine Minute, um das Makro auszuführen, aber dies wird länger, wenn die Daten wachsen.
Es gibt viel auf dieser Site über die Verwendung von Arrays, um Aufgaben schneller zu erledigen, aber keines der Beispiele macht für mich viel Sinn und ich würde es vorziehen, sie wenn möglich nicht zu verwenden.
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
Antworten
Hier ist ein anderer Weg:
BEARBEITEN - aktualisiert, um "Averageifs" und "Sumifs" zu meiner anfänglichen (irrtümlichen) "Countifs" -Version hinzuzufügen ...
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
@ RuthMac77 Sie sollten sich den Rat von Chris Neilsen anhören und SO nach möglichen Array-Lösungen suchen oder alternativ eine Google-Suche nach Array-Tutorials durchführen - es gibt viele.
Trotzdem habe ich hier vor einigen Jahren eine sehr ähnliche Frage beantwortet . Mit Ihrer Beschreibung habe ich die Datenstruktur, wie Sie sie beschrieben haben, mit 50.000 Datenzeilen repliziert. Das Testen mit Ihrem vorhandenen Code dauerte ungefähr 55 Sekunden.
Bei Verwendung der unten beschriebenen Verkettungs- / Sortier- / IF-Methode dauerte die Berechnung derselben Daten nur 1,5 Sekunden. Kopieren Sie den Code in Ihr Modul und lassen Sie mich wissen, wie Sie damit umgehen.
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