Bonjour et bienvenue sur le forum
Bonjour à tous
Un autre essai à tester.
Option Explicit
Dim dico As Object, tablo
Dim i&, j&
Sub NoteMax()
tablo = Range("A3").CurrentRegion
Set dico = CreateObject("Scripting.Dictionary")
For i = 3 To UBound(tablo, 1)
For j = 1 To 3 Step 2
If dico.exists(tablo(i, j)) Then
dico(tablo(i, j)) = Application.Max(dico(tablo(i, j)), tablo(i, j + 1))
Else
dico(tablo(i, j)) = tablo(i, j + 1)
End If
Next j
Next i
Range("E3").Resize(dico.Count, 1) = Application.Transpose(dico.keys)
Range("F3").Resize(dico.Count, 1) = Application.Transpose(dico.items)
Range("E3:F" & Range("E" & Rows.Count).End(xlUp).Row).Sort key1:=Range("E3"), _
order1:=xlAscending, Header:=xlNo
End Sub
Bye !