|
こんにちは
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セルに対象文字が複数ある場合にも対応しておきました。
|
|