转载
Sub 将某一关键词标红()
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
来源:http://www.exceltip.net/thread-17076-1-1.html