Sub test() arr = Range("A1:A14") For Each Rng In Range("C1:C6") For i = 1 To 14 n = InStr(Rng, arr(i, 1)) If n <> 0 Then Rng.Characters(n, Len(arr(i, 1))).Font.ColorIndex = 3 Next Next End Sub 试试?
Sub test() arr = Range("A1:A6") For Each Rng In Range("B1:B5") For i = 1 To 6 n = Len(arr(i, 1)) For j = 1 To Len(Rng) If Mid(Rng, j, n) = arr(i, 1) Then Rng.Characters(j, n).Font.ColorIndex = 3 Next Next Next End Sub 这个可以处理重复的。