Sub Ss()
Dim c As Range
n = InputBox("请输入需改变颜色的词语:")
If n = "" Then Exit Sub
For Each c In ActiveSheet.UsedRange
i = 1
While InStr(i, c, n, 0) > 0
i0 = InStr(i, c, n, 0)
If i0 > 0 Then c.Characters(i0, Len(n)).Font.Color = vbRed: i = i0 + Len(n)
Wend
Next
End Sub