Sub pyrof()
'-----------------------------------------------------------
' Analyse des données
'-----------------------------------------------------------
l = 4: c = 1
Dim tab1
Set tab1 = CreateObject("Scripting.dictionary")
While Cells(l, c) <> ""
cle1 = Cells(l, 1)
For b = 2 To 4
If Cells(l, b) <> "" Then
cle2 = Cells(l, b)
cle = cle1 & "_" & cle2
If tab1.exists(cle) = False Then
c1 = ""
c2 = ""
c3 = ""
If Cells(l, 2) = cle2 Then c1 = cle2
If Cells(l, 3) = cle2 Then c2 = cle2
If Cells(l, 4) = cle2 Then c3 = cle2
tab1(cle) = Array(c1, c2, c3, Cells(l, 5))
Else
tmp = tab1(cle)
tmp(3) = tmp(3) + Cells(l, 5)
tab1(cle) = tmp
End If
End If
Next
l = l + 1
Wend
'-----------------------------------------------------------
' ecriture des résultats
'-----------------------------------------------------------
l = 4: c = 12
For Each cle In tab1
Cells(l, c) = Split(cle, "_")(0)
Range(Cells(l, c + 1), Cells(l, c + 4)) = tab1(cle)
l = l + 1
Next
End Sub