[已解决]求助，如何只高亮所有关键词字体，难点在于有的单元格内关键词出现多次，并且位置随机

youxianwei

求助，如何只高亮所有关键词字体，难点在于有的单元格内关键词出现多次，并且位置随机

最佳答案

月排行榜 / 总排行榜

爱疯

2016-10-31 10:37

Sub test()
    Dim str, reg, match, matchs, x
    Set reg = CreateObject("VBScript.RegExp")
    reg.Global = True
    str = "关键词"

    For Each x In ActiveSheet.UsedRange
        If InStr(x, str) Then
            x.Font.ColorIndex = xlAutomatic
            reg.Pattern = str
            Set matchs = reg.Execute(x)
            For Each match In matchs
                x.Characters(Start:=match.firstindex + 1, Length:=match.Length).Font.ColorIndex = 3
            Next
        End If
    Next
End Sub

跳转到最佳答案楼层

砂海

Sub 宏1()

Dim x

x = Application.Find("的", Range("B17"))

    With ActiveCell.Characters(Start:=x, Length:=1).Font   
        .Name = "Arial Unicode MS"
        .FontStyle = "常规"
        .Size = 20
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .Color = -16776961
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With

End Sub

================上为局部
================以下整体思路
On Error GoTo 单个完成
    'for 区域循环
单个开始:
            套用上面程序 '查找不到会出错跳转
    GoTo 单个开始
单个完成:
    Next

su45

2164.zip (16.65 KB, 下载次数: 28)

2016-10-31 10:34 上传

点击文件名下载附件

爱疯

Sub test()
    Dim str, reg, match, matchs, x
    Set reg = CreateObject("VBScript.RegExp")
    reg.Global = True
    str = "关键词"

    For Each x In ActiveSheet.UsedRange
        If InStr(x, str) Then
            x.Font.ColorIndex = xlAutomatic
            reg.Pattern = str
            Set matchs = reg.Execute(x)
            For Each match In matchs
                x.Characters(Start:=match.firstindex + 1, Length:=match.Length).Font.ColorIndex = 3
            Next
        End If
    Next
End Sub

youxianwei

多谢大家的帮助

youxianwei

爱疯的答案速度更快，原理菜鸟我慢慢消化，再次谢谢大家帮助

youxianwei

？？？？？？？？？