| 
    
     |  | こんにちは 
 I列をループして、J、L列を処理してます。
 
 Sub test2_1()
 Dim r As Range
 Application.ScreenUpdating = False
 For Each r In Range("I2", Range("I" & Rows.Count).End(xlUp))
 test2_2 r, "J1"
 test2_2 r, "L1"
 Next
 Application.ScreenUpdating = True
 End Sub
 
 Sub test2_2(t As Range, c As String)
 Dim i As Long
 Dim j As Long
 With t.EntireRow.Range(c)
 i = InStr(1, .Value, t.Value)
 If i > 0 Then
 .Characters(Start:=i, Length:=Len(t.Value)) _
 .Font.ColorIndex = 3
 j = i + Len(t.Value)
 Do Until j > Len(.Value)
 i = InStr(j, .Value, t.Value)
 If i > 0 Then
 .Characters(Start:=i, Length:=Len(t.Value)) _
 .Font.ColorIndex = 3
 j = i + Len(t.Value)
 Else
 Exit Do
 End If
 Loop
 End If
 End With
 End Sub
 
 1セルに対象文字が複数ある場合にも対応しておきました。
 
 
 |  |