Private Sub Worksheet_Activate()
Dim ncol%, tablo, resu(), d As Object, i&, x$, lig&, j%, n&
With Sheets("MATRICE").[A1].CurrentRegion 'adapter éventuellement
ncol = .Columns.Count
If ncol = 1 Then ncol = 2 'au moins 2 cellules
tablo = .Resize(, ncol)
End With
ReDim resu(1 To Rows.Count, 1 To ncol)
Set d = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(tablo)
x = tablo(i, 1)
If d.exists(x) Then
lig = d(x)
If tablo(i, 2) < resu(lig, 2) Then
For j = 1 To ncol: resu(lig, j) = tablo(i, j): Next j
End If
Else
n = n + 1
d(x) = n 'mémorisation
For j = 1 To ncol: resu(n, j) = tablo(i, j): Next j
End If
Next i
'---restitution---
If FilterMode Then ShowAllData 'si la feuille est filtrée
With [A2] '1ère cellule de restitution, adapter éventuellement
If n Then
.Resize(n, ncol) = resu
.Resize(n, ncol).Borders.Weight = xlThin 'bordures
End If
.Offset(n).Resize(Rows.Count - n - .Row + 1, ncol).Delete xlUp 'RAZ en dessous
End With
Columns.AutoFit 'ajustement largeurs
With UsedRange: End With 'actualise la barre de défilement verticale
End Sub