voilà tip top :
Sub jmd()
'met en rouge les 3 derniers caractères d'un nombre de 10 chiffres'
'pour autant que ces 3 caractères ont au moins 1 doublon dans la liste sélectionnée
'le nombre est ensuite scindé en groupes de 4+3+3 chiffres
Dim cellule As Object, x As String
Dim i, k, nb_cell As Integer
Dim t(800, 2)
Range("A1:A800").Select
Selection.NumberFormat = "@"
'tri croissant sur les 3 derniers caractères
For k = 1 To 800
Cells(k, 14) = Left(Cells(k, 1), 4) & " " & Right(Left(Cells(k, 1), 7), 3) & " " & Right(Cells(k, 1), 3)
Cells(k, 13) = Right(Cells(k, 1), 3)
Next
Range("M1:N800").Select
Selection.Sort Key1:=Range("M1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
For k = 1 To 800
Cells(k, 1) = Cells(k, 14)
Next
'effacer zone de travail
Range("M1:N800").Select
Selection.Clear
Range("a1").Select
' mise au format texte, comptage des cellules
' et création du tableau pour tester les doublons
'------------------------
Range("A1:A800").Select
k = 0
For Each cellule In Selection
k = k + 1
t(k, 1) = Right(cellule, 3)
t(k, 2) = 0
nb_cell = nb_cell + 1
Next
'comptage des doublons
'----------------
For k = 1 To nb_cell
x = t(k, 1)
For i = 1 To nb_cell
If t(i, 1) = x Then
t(k, 2) = t(k, 2) + 1
End If
Next i
Next k
'traitement couleur des cellules
'---------------------
k = 0
For Each cellule In Selection
k = k + 1
If t(k, 2) > 1 Then
x = cellule
cellule = x
cellule.Characters(Start:=1, Length:=0).Font.ColorIndex = xlAutomatic
cellule.Characters(Start:=10, Length:=0).Font.ColorIndex = 3
cellule.Characters(Start:=10, Length:=0).Font.FontStyle = "Italique"
End If
Next
Range("a1").Select
End Sub