1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39
| Sub testdico()
Application.ScreenUpdating = False
With Sheets("Feuil2")
.Cells.ClearContents
.Cells(1, 1).Resize(1, 3) = Array(Sheets("feuil1").Range("A1").Value, Sheets("feuil1").Range("B1").Value, Sheets("feuil1").Range("C1").Value)
End With
Dim T
Set dico = CreateObject("Scripting.dictionary")
With Sheets("Feuil1")
dernl = .Range("A" & .Rows.Count).End(xlUp).Row
For j = 2 To dernl
x = .Range("A" & j) & ";" & .Range("B" & j)
dico(x) = .Range("A" & j) & ";" & .Range("B" & j)
Next j
Cle = dico.Keys
L = 2
End With
With Sheets("feuil2")
.Activate
For I = 0 To dico.Count - 1
T = Split(dico(Cle(I)), ";")
.Cells(L, 1).Value = Cle(I)
.Cells(L, 1).Value = T(0)
.Cells(L, 2).Value = T(1)
L = L + 1
Next
End With
' Je demande si c'est possible d'éviter cette boucle !!!!! et l'intégrer lors de remplissage du dico
With Sheets("feuil2")
dernligne = .Range("A" & .Rows.Count).End(xlUp).Row
For I = 2 To dernligne
.Cells(I, "C").Value = Application.WorksheetFunction.SumIfs(Sheets("feuil1").Range("C1:C" & dernl), Sheets("feuil1").Range("A1:A" & dernl), .Cells(I, "A"), Sheets("feuil1").Range("B1:B" & dernl), .Cells(I, "B"))
Next I
End With
Application.ScreenUpdating = True
End Sub |
Partager