بعد اذن الاستاد الرائد قد يساعدك هذا الكود
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range, dic As Object, rng As Range, chn As Range
Dim sNms As Variant, a_b As String, i As Long
Set chn = Intersect(Target, Range("C:C"))
If Not Intersect(Target, Range("C:C")) Is Nothing Then
Set rng = Range("C1", Range("C" & Rows.Count).End(3))
Set dic = CreateObject("Scripting.Dictionary")
dic.comparemode = vbTextCompare
rng.Font.Bold = True
rng.Font.ColorIndex = xlAutomatic
For Each c In rng
sNms = Split(c, " ")
a_b = ""
If UBound(sNms) = 2 Or UBound(sNms) = 3 Then
a_b = Trim(sNms(0) & " " & sNms(1) & " " & sNms(2))
If Not dic.exists(a_b) Then
If UBound(sNms) = 3 Then
dic(a_b) = c.Row
End If
Else
c.Characters(1, Len(a_b)).Font.Color = vbRed
Range("C" & dic(a_b)).Characters(1, Len(a_b)).Font.Color = vbRed
End If
End If
Next c
End If
End Sub
11.xlsm