confrontare il contenuto di due celle e ...

Sub prova()
Dim i As Integer
Dim ur As Long
Dim rng As Range
Dim cel As Range
ur = Cells(Rows.Count, 3).End(xlUp).Row
Set rng = Range("C2:c" & ur)
For Each cel In rng
    For i = 1 To Len(cel.Value)
        If InStr(1, cel.Offset(0, -1).Value, Mid(cel.Value, i, 1)) <> 0 Then
            cel.Characters(Start:=i, Length:=1).Font.ColorIndex = 3
        End If
    Next i
Next cel
End Sub

Dim i As Integer
Dim ur As Long
Dim rng As Range
Dim cel As Range

ur = Cells(Rows.Count, 3).End(xlUp).Row

Set rng = Range("C2:c" & ur)

For Each cel In rng

For i = 1 To Len(cel.Value)

If InStr(1, cel.Offset(0, -1).Value, Mid(cel.Value, i, 1)) <> 0 Then
cel.Characters(Start:=i, Length:=1).Font.ColorIndex = 3
End If

Next i
Next cel

End Sub

Instr(1, "Pamelina", "m")

Option Explicit

Sub confronta_ed_evidenzia()
Dim r As Long, n As Long
Dim parola As String, stringa As String, cercato As String
Dim test1 As Boolean, test2 As Boolean

Dim rng As Range, rng1 As Range
Dim ur As Long, ur1 As Long
Dim cellaA As Range, cellaB As Range

ur = Cells(Rows.Count, "e").End(xlUp).Row
ur1 = Cells(Rows.Count, "f").End(xlUp).Row

Application.ScreenUpdating = False

Set rng = Range("e2:e" & ur)
Set rng1 = Range("f2:f" & ur1)

For Each cellaA In rng
  parola = cellaA.Value
  stringa = cellaA.Offset(0, 1).Value

  For r = 1 To Len(parola)

    cercato = Mid(parola, r, 1)
    test1 = stringa Like "*" & cercato & "*"

    If test1 = True Then
    '===============================================================
    'Per questa riga ringrazio Alfredo: non la conoscevo. LOL
    cellaA.Characters(Start:=r, Length:=1).Font.ColorIndex = 3
    cellaA.Characters(Start:=r, Length:=1).Font.Bold = True
    '===============================================================

    End If
 Next r
Next cellaA
 
For Each cellaB In rng1
  parola = cellaB.Value
  stringa = cellaB.Offset(0, -1).Value

  For n = 1 To Len(parola)

    cercato = Mid(parola, n, 1)
    test2 = stringa Like "*" & cercato & "*"

    If test2 = True Then
    '===============================================================
    'Per questa riga ringrazio Alfredo: non la conoscevo. LOL
    cellaB.Characters(Start:=n, Length:=1).Font.ColorIndex = 3
    cellaB.Characters(Start:=n, Length:=1).Font.Bold = True
    '===============================================================
    End If
  Next n
Next cellaB


Set rng = Nothing
Set rng1 = Nothing
Application.ScreenUpdating = True
End Sub