TROVA NUMERI DISTANTI

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