VBA之正则表达式（41）-- 快速标记两个星号之后的字符

实例需求：工作表中的数据保存在A列~G列，现需要识别D列中包含超过两个星号的内容，并将第3个星号及其之后的字符设置为红色字体，如图所示。

示例代码如下。

Sub Demo1()
    Dim objRegExp As Object
    Dim objMatch As Object
    Dim strMatch As String
    Dim iLoc As Integer, strTxt As String
    arrData = [a1].CurrentRegion
    ActiveSheet.Columns(4).Font.Color = vbNone
    Set objRegExp = CreateObject("vbScript.Regexp")
    With objRegExp
        .Global = True
        .Pattern = "^\*[一-龟]+\*[一-龟]+(.*)$"
        For i = 2 To UBound(arrData)
            strTxt = arrData(i, 4)
            Set objMatch = .Execute(strTxt)
            If objMatch.Count > 0 Then
                strMatch = objMatch(0).submatches(0)
                If Len(strMatch) > 0 Then
                    iLoc = VBA.InStrRev(strTxt, strMatch)
                    Cells(i, 4).Characters(iLoc, Len(strTxt) - iLoc + 1).Font.Color = vbRed
                End If
            End If
        Next i
    End With
    Set objRegExp = Nothing
    Set objMatch = Nothing
End Sub

【代码解析】
第6行代码将A1单元格所在的数据区域加载到数组中。
第7行代码将D列单元格字体颜色设置为“自动”。
第8行代码创建正则对象。
第10行代码设置正则全局匹配。
第11行代码设置正则匹配规则。

正则表达式	说明
^	匹配开始位置
\*[一-龟]+	匹配一个星号加多个中文字符
$	匹配最后位置

第12~22行代码循环处理每行数据。
第13行代码读取D列单元格内容。
第14行代码执行正则匹配。
第15行代码判断是否匹配成功。
第16行代码读取匹配组内容。
第17行代码匹配组内容是否为空。
第18行代码在单元格内容中查找匹配组的字符位置。
注意此处必须使用InStrRev，而不能使用如下代码，如果单元格内容中有重复字符，下述方法定位的位置将出现错误，例如：*万事如意*身体健康*万事如意。
iLoc = VBA.InStr(1, strTxt, strMatch)
第19行代码设置相应字符的字体颜色为红色。
第24~25行代码释放对象变量占用的系统资源。

---

不使用VBA字符查找，也可以可以完美实现这个问题。

Sub Demo2()
    Dim objRegExp As Object
    Dim objMatch As Object
    Dim strMatch As String
    Dim iLoc As Integer, strTxt As String
    arrData = [a1].CurrentRegion
    ActiveSheet.Columns(4).Font.Color = vbNone
    Set objRegExp = CreateObject("vbScript.Regexp")
    With objRegExp
        .Global = True
        .Pattern = "\*[一-龟]+"
        For i = 2 To UBound(arrData)
            strTxt = arrData(i, 4)
            Set objMatch = objRegExp.Execute(strTxt)
            If objMatch.Count > 2 Then
                iLoc = objMatch(2).firstindex + 1
                Cells(i, 4).Characters(iLoc, Len(strTxt) - iLoc + 1).Font.Color = vbRed
            End If
        Next i
    End With
    Set objRegExp = Nothing
    Set objMatch = Nothing
End Sub

【代码解析】
第15行代码判断匹配成功的数量是否超过两个。
第16行代码代码使用第3个匹配组（objMatch(2)）的firstindex属性获取字符起始位置，由于正则对象中编号都是0开始的，所以需要加1才能应用于第17行代码中。