Bonsoir NCC 1701, D10 le forum
Je suis parti sur le fichier fourni au post #5 8)
A tester :
Attention au nom des feuilles
Option Explicit
Sub test()
Dim a, w(), i As Long, ii As Long, n As Long, dico As Object
Set dico = CreateObject("Scripting.Dictionary")
dico.CompareMode = 1
With Sheets(1) 'la 1ere feuille du classeur
With .Range("a5", .Range("a" & .Rows.Count).End(xlUp)).Resize(, 10)
a = Application.Index(.Value, Evaluate("row(1:" & _
.Rows.Count & ")"), Array(1, 3, 6, 8, 10))
End With
For i = 1 To UBound(a, 1)
If Not dico.exists(a(i, 1)) Then
Set dico(a(i, 1)) = CreateObject("Scripting.Dictionary")
dico(a(i, 1)).CompareMode = 1
End If
dico(a(i, 1))(a(i, 2)) = VBA.Array(a(i, 1), a(i, 2), a(i, 3), a(i, 4), _
a(i, 5), Empty, a(i, 1), a(i, 2), Empty, _
Empty, Empty, Empty, Empty, Empty, Empty)
Next
End With
With Sheets(2) 'la 2eme feuille du classeur
With .Range("b5", .Range("b" & .Rows.Count).End(xlUp)).Resize(, 9)
a = Application.Index(.Value, Evaluate("row(1:" & _
.Rows.Count & ")"), Array(1, 2, 7, 9, 5))
End With
For i = 1 To UBound(a, 1)
If dico.exists(a(i, 1)) Then
w = dico(a(i, 1))(a(i, 2))
w(8) = a(i, 3): w(9) = a(i, 4): w(10) = a(i, 5)
w(12) = w(2) - w(8): w(13) = w(3) - w(9): w(14) = w(4) - w(10)
dico(a(i, 1))(a(i, 2)) = w
End If
Next
End With
Application.ScreenUpdating = False
'Restitution dans la 3eme feuille du classeur
With Sheets(3).Range("a4")
.Offset(2).CurrentRegion.Resize(, 15).ClearContents
If dico.Count > 0 Then
n = 2
For i = 0 To dico.Count - 1
For ii = 0 To dico.items()(i).Count - 1
With .Offset(n).Resize(1, UBound(dico.items()(i).items()(ii), 1) + 1)
.Value = dico.items()(i).items()(ii)
End With
n = n + 1
Next
Next
End If
End With
Set dico = Nothing
Application.ScreenUpdating = True
End Sub
On peut remplacer la dernière boucle par celle-ci :
'Restitution dans la 3eme feuille du classeur
With Sheets(3).Range("a4")
.Offset(2).CurrentRegion.Resize(, 15).ClearContents
If dico.Count > 0 Then
n = 2
For i = 0 To dico.Count - 1
With .Offset(n).Resize(UBound(Application.Transpose(dico.items()(i).items), 2), _
UBound(Application.Transpose(dico.items()(i).items), 1))
.Value = Application.Transpose(Application.Transpose(dico.items()(i).items))
End With
n = n + UBound(Application.Transpose(dico.items()(i).items), 2)
Next
End If
End With
klin89