Dim Rng As Range, RngStart As Range, Str$, N%
On Error GoTo skip  '设置出错跳转
Str = InputBox("请输入要查找的内容：", "输入")  '利用输入框输入要查找的内容
If Cells.Find(Str) Is Nothing Then  '如果工作表未找到要查找的内容及提示
    MsgBox "未发现要查找的内容"
Else    '如果找到则开始执行替换字体操作
    Set RngStart = Cells.Find(Str)  '先取得第一个找到的单元格位置
    Set Rng = RngStart  '再转赋值给处理中用的动态变量
    Do
        With Rng    '因字体颜色只能设置给字符串，故将单元格格式先处理成文本（会修改公式为显示值，可通过判断不处理一些类型的单元格）
            .NumberFormatLocal = "@"
            .Value = .Text
        End With
        N = InStr(Rng.Value, Str)   '取得字符串所处的第一个位置
        Do
            With Rng.Characters(InStr(N, Rng.Value, Str), Len(Str)) '修改对应位置的文本颜色为红色
                .Font.Color = vbRed
            End With
            N = InStr(N + 1, Rng.Value, Str)    '提取下一个文本串的位置
        Loop While N > 0    '如果存在下一个文本串则继续循环
        Set Rng = Cells.FindNext(Rng)   '转到下一个找到的文本的单元格
    Loop Until Rng = RngStart   '当单元格不是初始单元格时继续循环（循环完毕后会再次回到第一个单元格，以此判断循环结束）
End If
skip:       '出错时跳转位置
End Sub
复制代码