Sub Distanti() Dim i As Integer Dim rng As Range Dim cel As Range Dim myArr() As String Set rng = Range("a2:F7") myArr = Split(Range("A1").Value) For Each cel In rng For i = LBound(myArr) To UBound(myArr) If cel.Value = myArr(i) Then cel.Interior.ColorIndex = 6 End If Next i Next cel End Sub
Sub coloraStr() Dim r, c, d, x, y, k, k1, p, p1, L, clr ActiveSheet.UsedRange.Select Selection.Font.ColorIndex = xlAutomatic Range("A1").Select clr = RGB(255, 0, 0) k = Cells(1, 13) k1 = Cells(2, 13) For x = 12 To Cells(Rows.Count, 1).End(xlUp).Row d = Cells(x, 1) If d Like "Scedina*" Then GoTo 1 L = Len(d) For y = 1 To L p = InStr(y, d, k, 1) p1 = InStr(y, d, k1, 1) If p <> 0 And p1 <> 0 Then If p1 - p < 18 Then Cells(x, 1).Characters(p, 2).Font.Color = clr Cells(x, 1).Characters(p1, 2).Font.Color = clr y = p1 End If End If Next y 1 Next x End Sub