Sub tabloSomm() 'patricktoulon sur la base de mapomme dans un tableau transposé
Dim t, dico As New Dictionary, i&, clef, ii&, j&, Ti, VA
Ti = Timer
t = Range("a1").CurrentRegion
ReDim VA(1 To 3, 1 To UBound(t))
Set dico = CreateObject("scripting.dictionary")
dico.CompareMode = TextCompare
For i = 2 To UBound(t)
clef = Join(Array(t(i, 2), t(i, 3)), "|")
If Not dico.Exists(clef) Then
ii = dico.Count + 1
dico(clef) = ii
VA(1, ii) = t(i, 2): VA(2, ii) = t(i, 3): VA(3, ii) = t(i, 16)
't(ii, 1) = t(i, 2): t(ii, 2) = t(i, 3): t(ii, 3) = t(i, 16)
Else
ii = dico(clef)
't(ii, 3) = t(ii, 3) + t(i, 16)
VA(3, ii) = VA(3, ii) + t(i, 16)
End If
Next i
ReDim Preserve VA(1 To 3, ii)
VA = Application.Transpose(VA)
'ReDim r(1 To dico.Count, 1 To 3)
'For i = 2 To dico.Count + 1
'For j = 1 To 3
' r(i - 1, j) = t(i - 1, j)
'Next j
'Next i
With Range("r1")
'.CurrentRegion.ClearContents: .Resize(UBound(r), 3) = r: .CurrentRegion.Borders.LineStyle = xlContinuous
.CurrentRegion.ClearContents: .Resize(UBound(VA), 3) = VA: .CurrentRegion.Borders.LineStyle = xlContinuous
End With
MsgBox Format(Timer - Ti, "0.000\ sec.")
End Sub