السلام عليكم
اخى ابو هادي شكرا لك
وهذه حسب طلبك
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim c As Range
Dim s As Long
Const threes As String = "3"
For Each c In Selection
s = 1
With c
.NumberFormat = "@"
.Value = CStr(.Value)
Do While InStr(s, c.Text, threes) > 0
s = InStr(s, c.Text, threes)
.Characters(s, 1).Font.Bold = True
.Characters(s, 1).Font.Color = vbRed
s = s + 1
Loop
End With
Next c
End Sub