Как выделить все осколки конкретной подстроки в ячейке?

Question

Я использовал нижеследующее, однако обнаружил, что он только подчеркивает/меняет цвет шрифта первой подстроки на ячейку. Как я могу убедиться, что он также выделяет последующие?

Sub test4String2color() 
    Dim strTest As String 
    Dim strLen As Integer 
    strTest = Range("F1") 
    strLen = Len(strTest) 
    For Each cell In Range("A1:D100") 
     If InStr(cell, strTest) > 0 Then 
     cell.Characters(InStr(cell, strTest), strLen).Font.Color = vbRed 
    End If 
    Next 
End Sub 

Answer 1

Вам просто нужно перебрать строки, пока вы не можете найти strTest больше. Используйте предыдущую находку для начала последовательных поисков.

Sub test4String2color() 
    Dim strTest As String, cell As Range 
    Dim strLen As Long, p As Long 

    With ActiveSheet 
     strTest = .Range("F1") 
     strLen = Len(strTest) 
     For Each cell In Intersect(.Range("A1:D100"), .UsedRange) 
      p = InStr(1, cell, strTest) 
      Do While CBool(p) 
       cell.Characters(p, strLen).Font.Color = vbRed 
       p = InStr(p + 1, cell, strTest) 
      Loop 
     Next 
    End With 
End Sub