Sub test()
Dim r%, i%
Dim arr, brr
Dim reg As New RegExp
With reg
.Global = True
.Pattern = "7" '关键字
End With
With Worksheets("sheet1")
r = .UsedRange.Find(what:="*", LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByRows, searchdirection:=xlPrevious).Row
c = .UsedRange.Find(what:="*", LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByColumns, searchdirection:=xlPrevious).Column
.UsedRange.Font.ColorIndex = 0
For i = 1 To r
For j = 1 To c
If Len(.Cells(i, j)) <> 0 Then
Set mh = reg.Execute(.Cells(i, j).Value)
If mh.Count > 0 Then
For k = 0 To mh.Count - 1
.Cells(i, j).Characters(Start:=mh(k).FirstIndex + 1, Length:=mh(k).Length).Font.ColorIndex = 3 '设置颜色
.Cells(i, j).Characters(Start:=mh(k).FirstIndex + 1, Length:=mh(k).Length).Font.Bold = True ' 字体加粗
.Cells(i, j).Characters(Start:=mh(k).FirstIndex + 1, Length:=mh(k).Length).Font.Size = 24 '设置字体大小为24磅
Next
End If
End If
Next
Next
End With
End Sub
高亮关键字
最新推荐文章于 2022-04-26 15:24:20 发布