Sub Nouveau_tableau()
Dim tablo, d As Object, d1 As Object, d2 As Object, i&, s, x$, maxi%, a, b, ubc%, c(), j%
'---analyse du tableau source---
tablo = Feuil1.UsedRange.Resize(, 10) 'matrice, plus rapide, à adapter
Set d = CreateObject("Scripting.Dictionary")
Set d1 = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
For i = 4 To UBound(tablo)
s = Split(tablo(i, 1))
If UBound(s) > 0 Then
x = s(0) & " " & s(1)
d(x) = IIf(d.exists(x), d(x), x) & Chr(1) & tablo(i, 6) & Chr(1) & tablo(i, 7) 'concaténation
d1(x) = d1(x) + 1 'comptage
d2(x) = tablo(i, 10) 'valeur en dernière ligne
End If
Next i
'---tableau des résultats---
Application.ScreenUpdating = False
With Feuil2 'CodeName de la feuille
If .FilterMode Then .ShowAllData 'si la feuille est filtrée
With .[A1].CurrentRegion.Offset(1)
.ClearContents 'RAZ
If .Columns.Count > 3 Then .Columns(3).EntireColumn.Resize(, .Columns.Count - 3).Delete 'racourcissement à 3 colonnes
If d.Count Then
maxi = Application.Max(d1.items)
.Columns(2).EntireColumn.Resize(, 2 * maxi - 1).Insert 'insertion des colonnes nécessaires
a = d.items: b = d2.items
ubc = 2 * maxi + 1
ReDim c(d.Count - 1, ubc) 'base 0
For i = 0 To UBound(b)
c(i, ubc) = b(i) 'dernière colonne
s = Split(a(i), Chr(1))
For j = 0 To UBound(s)
c(i, j) = s(j)
Next j, i
.Columns(1).Resize(d.Count, ubc + 1) = c
For i = 2 To 2 * maxi Step 2: .Columns(i).EntireColumn.HorizontalAlignment = xlCenter: Next 'centrage
End If
End With
.Columns.AutoFit 'ajustement largeur
With .UsedRange: End With 'actualise les barres de défilement
.Activate 'facultatif
End With
End Sub