Sub cherche(vCell As Range)
Dim AnyString, MyStr
AnyString = vCell ' Définit la chaîne.
Dim i As Byte, nbcar As Byte
nbcar = Len(AnyString)
vCell.Font.ColorIndex = 1
For i = 1 To nbcar
MyStr = Right(Left(AnyString, i), 1)
If MyStr <> 1 And MyStr <> 2 And MyStr <> 3 Then _
vCell.Characters(Start:=i, Length:=1).Font.ColorIndex = 3
Next i
End Sub