也许这会适合(确保在运行之前选择不超过必要的单元格,否则这可能需要一段时间):
Sub FormatSelection()
Dim cl As Range
Dim SearchText As String
Dim StartPos As Integer
Dim EndPos As Integer
Dim TestPos As Integer
Dim TotalLen As Integer
On Error Resume Next
Application.DisplayAlerts = False
SearchText = Application.InputBox _
(Prompt:="Enter string.", Title:="Which string to format?", Type:=2)
On Error GoTo 0
Application.DisplayAlerts = True
If SearchText = "" Then
Exit Sub
Else
For Each cl In Selection
TotalLen = Len(SearchText)
StartPos = InStr(cl, SearchText)
TestPos = 0
Do While StartPos > TestPos
With cl.Characters(StartPos, TotalLen).Font
.FontStyle = "Bold"
.ColorIndex = 3
End With
EndPos = StartPos + TotalLen
TestPos = TestPos + EndPos
StartPos = InStr(TestPos, cl, SearchText, vbTextCompare)
Loop
Next cl
End If
End Sub
应该大胆并染上红色。如果重新运行宏,更改不会被覆盖。注释掉 .ColorIndex = 3 如果不改变颜色。
(基于@Skip Intro 对 SO15438731 问题的修正以及来自 SO10455366 答案的一些代码。)