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 40 41 42
| Application.ScreenUpdating = False 'juste pour arrêter affichage écran et améliorer le temps d'exécution du macro
'***********************************Effacer Enciennes Données
With Sheets("feuil3")
.Cells.ClearContents
End With
Dim T
Set dico = CreateObject("Scripting.dictionary")
With Sheets("Quantité produite")
dernl = .Range("D" & .Rows.Count).End(xlUp).Row
For j = 1 To dernl
x = .Range("A" & j) & ";" & .Range("B" & j) & ";" & .Range("C" & j) & ";" & .Range("D" & j) & ";" & .Range("E" & j)
dico(x) = .Range("A" & j) & ";" & .Range("B" & j) & ";" & .Range("C" & j) & ";" & .Range("D" & j) & ";" & .Range("E" & j)
Next j
Cle = dico.Keys
L = 1
TABLO = .Range("A1", "F" & .Range("F" & .Rows.Count).End(xlUp).Row)
End With
With Sheets("feuil3")
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)
.Cells(L, 3).Value = T(2)
.Cells(L, 4).Value = T(3)
.Cells(L, 5).Value = T(4)
L = L + 1
Next
dernligne = .Range("D" & .Rows.Count).End(xlUp).Row
Dim somme As Variant
For j = 1 To dernligne
For i = LBound(TABLO, 1) To UBound(TABLO, 1)
If .Cells(j, 5) = TABLO(i, 5) And .Cells(j, 4) = TABLO(i, 4) Then
somme = somme + TABLO(i, 6)
.Cells(j, 6) = somme
End If
Next i
somme = 0
Next j
End With |
Partager