Utilisation plus rapide de Sumifs ()
J'ai une tâche hebdomadaire où je dois mettre à jour un rapport (actuellement un peu plus de 50 000 lignes) qui augmente d'environ 500 lignes chaque semaine. Une fois les nouvelles données ajoutées manuellement, j'exécute le code ci-dessous pour faire un Sumifs()
pour résumer les données.
La structure des données est la suivante: les colonnes A à C sont les colonnes de critères (numérique-alphanumérique), la colonne D a la quantité à additionner (nombres entiers). Les données sont contiguës. Ma macro met la Sumifs()
formule dans la colonne E - écrasant ce qu'il y a.
Ma question est la suivante: cette tâche peut-elle être effectuée plus rapidement? Il me faut actuellement un peu plus d'une minute pour exécuter la macro, mais cela s'allonge à mesure que les données augmentent.
Il y a beaucoup de choses sur ce site sur l'utilisation des tableaux pour effectuer des tâches plus rapidement, mais aucun des exemples n'a beaucoup de sens pour moi et je préférerais ne pas les utiliser si 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
Réponses
Voici une autre façon:
EDIT - mis à jour pour ajouter des "averageifs" et "sumifs" à ma version initiale (erronée) de "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
@ RuthMac77, vous devriez écouter les conseils de chris neilsen et rechercher des solutions possibles pour les tableaux, ou faire une recherche sur Google pour les didacticiels sur les tableaux - il y en a beaucoup.
Cela dit, je répondu à une question très semblable à celui - ci il y a quelques années ici . En utilisant votre description, j'ai répliqué la structure de données telle que vous l'avez décrite avec 50 000 lignes de données. Le tester à l'aide de votre code existant a pris environ 55 secondes.
En utilisant la méthode concaténation / tri / IF décrite ci-dessous, les mêmes données n'ont pris que 1,5 seconde à calculer. Copiez le code dans votre module et dites-moi comment vous allez avec.
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