Sub Variations()
Dim dest As Range, tablo, nlig&, ncol%, d1 As Object, d2 As Object, j%, i&, resu
Set dest = [A25] 'à adapter
tablo = [A1].CurrentRegion 'matrice, plus rapide
If Not IsArray(tablo) Then Exit Sub 'sécurité
nlig = UBound(tablo): ncol = UBound(tablo, 2)
Set d1 = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
'---détermination des variations par ligne---
d1("") = "" 'au moins 1 élément
For j = 2 To ncol
For i = 2 To nlig
If i = 2 Or tablo(i, j) <> tablo(i - 1, j) Then _
If Not d1.exists(tablo(i, 1)) Then d1(tablo(i, 1)) = i 'mémorise la ligne
Next i, j
'---détermination des variations par colonne---
d2("") = "" 'au moins 1 élément
For i = 2 To nlig
For j = 2 To ncol
If j = 2 Or tablo(i, j) <> tablo(i, j - 1) Then _
If Not d2.exists(tablo(1, j)) Then d2(tablo(1, j)) = j 'mémorise la colonne
Next j, i
Application.ScreenUpdating = False
'---en-têtes de lignes des résultats---
With dest.Resize(d1.Count)
.Value = Application.Transpose(d1.keys) 'Transpose est limitée à 65536 lignes
.Offset(d1.Count).Resize(Rows.Count - d1.Count - .Row + 1, Columns.Count - .Column + 1).Delete xlUp 'RAZ en dessous
.Sort .Cells(1), xlDescending, Header:=xlYes, Orientation:=1 'tri vertical décroissant
End With
'---en-têtes de colonnes des résultats---
With dest.Resize(, d2.Count)
.Value = d2.keys
.Offset(, d2.Count).Resize(d1.Count, Columns.Count - d2.Count - .Column + 1).Delete xlToLeft 'RAZ à droite
.Offset(, 1).Sort .Cells(1, 2), xlAscending, Orientation:=2 'tri horizontal croissant
End With
'---valeurs des résultats---
With dest.Resize(d1.Count, d2.Count)
.Borders.Weight = xlThin 'bordures'
resu = .Value 'matrice, plus rapide
ncol = d2.Count
For i = 2 To d1.Count
For j = 2 To ncol
resu(i, j) = tablo(d1(resu(i, 1)), d2(resu(1, j)))
Next j, i
.Value = resu
With .Parent.UsedRange: End With 'actualise les barres de défilement
End With
End Sub