Sub DansQuelEtatJerre()
Dim tablo, i&, k&, premLig&, nLig&, derLig&, clef, kis, nbr&
Dim dico, res()
Set dico = CreateObject("scripting.dictionary")
dico.CompareMode = vbTextCompare
nLig = Cells(Rows.Count, "c").End(xlUp).Row
' En partant du bas du tableau source, par bloc de 20000 lignes
' on stocke les couples (articles,magasin) avec leur état dans dico.
' On stocke le premier couple rencontré (du bas vers le haut).
' Si un couple est déjà dans dico, on abandonne le couple en cours
' puisque son dernier état est déjà dans le dico
For i = nLig To 3 Step -20000
derLig = i: premLig = i - 20000 + 1: If premLig < 3 Then premLig = 3
tablo = Range(Cells(premLig, "c"), Cells(derLig, "e"))
For k = UBound(tablo) To 1 Step -1
clef = tablo(k, 1) & "\" & tablo(k, 2)
If Not dico.Exists(clef) Then dico.Add clef, tablo(k, 3)
Next k
Next i
' on efface la précedente zone de résultat
Range("h2:j" & Rows.Count).Clear: Range("h2:j2") = Range("c2:e2").Value
nbr = dico.Count - 1
If nbr < 0 Then
MsgBox "Aucune donnée en résultat -> Echec"
Exit Sub
End If
' construire le tableau des résultats et l'afficher
ReDim res(0 To nbr, 0 To 2): i = 0
For Each kis In dico.Keys
k = InStr(kis, "\"): res(i, 0) = Left(kis, k - 1)
res(i, 1) = Mid(kis, k + 1): res(i, 2) = dico(kis)
i = i + 1
Next kis
Range("h3").Resize(nbr + 1, 3) = res
'formatage et tri du résultat
Set dico = Nothing
Range("h2").Resize(nbr + 2, 3).Borders.LineStyle = msoLineSingle
Range("h2").Resize(, 3).Interior.Color = RGB(200, 200, 200)
Range("h2").Resize(, 3).Font.Bold = True
Range("h2").Resize(nbr + 2, 3).Sort _
key1:=Range("h2"), key2:=Range("i2"), Header:=xlYes, _
order1:=xlAscending, order2:=xlAscending
Range("h2").Resize(, 3).EntireColumn.AutoFit
MsgBox "Traitement terminé"
Application.Goto [a1], True
End Sub
