excelperfect
标签：VBA
下面的代码将突出显示在单元格文本字符串中用户定义的文本字符串，对其设置颜色并加粗。
VBA代码如下：
代码语言：javascript复制'使用颜色和加粗来突出显示词库中的文字
Sub ColorandBold()
Dim myCell As Range
Dim myRng As Range
Dim FirstAddress As String
Dim iCtr As Long
Dim letCtr As Long
Dim startrow As Long '开始的单元格区域位置
Dim endrow As Long ' 结束的单元格区域位置
Dim startcolumn As Integer '开始列
Dim endcolumn As Integer '结束列
Dim myWords
'设置要应用突出显示词库文字的单元格区域
'你可以根据你的需要来修改
startrow = 2
endrow = 5
startcolumn = 1
endcolumn = 2
Set myRng = Range(Cells(startrow, startcolumn), Cells(endrow, endcolumn))
'设置词库
'即想要添加颜色和加粗的词语
myWords = Array("完美Excel", "excelperfect", "Excel")
'开始主循环---------------------------------------
For iCtr = LBound(myWords) To UBound(myWords)
'忽略错误
On Error Resume Next
With myRng
Set myCell = .Find(What:=myWords(iCtr), After:=.Cells(1), _
LookIn:=xlValues, LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
'检查
If Not myCell Is Nothing Then
FirstAddress = myCell.Address
Do
For letCtr = 1 To Len(myCell.Value)
If StrComp(Mid(myCell.Value, letCtr, _
Len(myWords(iCtr))), _
myWords(iCtr), vbTextCompare) = 0 Then
myCell.Characters(Start:=letCtr, _
Length:=Len(myWords(iCtr))) _
.Font.ColorIndex = 5
End If
Next letCtr
For letCtr = 1 To Len(myCell.Value)
If StrComp(Mid(myCell.Value, letCtr, _
Len(myWords(iCtr))), _
myWords(iCtr), vbTextCompare) = 0 Then
myCell.Characters(Start:=letCtr, _
Length:=Len(myWords(iCtr))) _
.Font.FontStyle = "Bold"
End If
Next letCtr
'获取相一个地址
Set myCell = .FindNext(myCell)
Loop While Not myCell Is Nothing _
And myCell.Address <> FirstAddress
End If
End With
Next iCtr
End Sub你只需对代码中设置要搜索的单元格区域的值修改为适合你工作表中的区域，定义自己的文本字符串即词库。在代码注释中我已标注出，有兴趣的朋友可以研究。
