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
| Sub Demo()
VA = Feuil1.Cells(1).CurrentRegion.Value
If UBound(VA, 2) < 5 Then Beep: Exit Sub
ReDim VR(1 To UBound(VA), 1 To 5)
For C% = 1 To 5: VR(1, C) = VA(1, C): Next
With CreateObject("Scripting.Dictionary")
For R& = 2 To UBound(VA)
If .Exists(VA(R, 2)) Then
L& = .Item(VA(R, 2))
VR(L, 4) = VR(L, 4) + VA(R, 4)
VR(L, 5) = VR(L, 5) + VA(R, 5)
Else
L = .Count + 2
.Add VA(R, 2), L
For C = 1 To 5: VR(L, C) = VA(R, C): Next
End If
Next
Feuil2.UsedRange.Clear
With Feuil2.[A1:E1].Resize(.Count + 1)
.Value = VR
.Columns.AutoFit
Application.Goto .Cells(1), True
End With
.RemoveAll
End With
End Sub |
Partager