政府门户网站 平安建设进入百度
实例需求：工作表中的数据保存在A列~G列，现需要识别D列中包含超过两个星号的内容，并将第3个星号及其之后的字符设置为红色字体，如图所示。
示例代码如下。
Sub Demo1()Dim objRegExp As ObjectDim objMatch As ObjectDim strMatch As StringDim iLoc As Integer, strTxt As StringarrData = [a1].CurrentRegionActiveSheet.Columns(4).Font.Color = vbNoneSet 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 ThenstrMatch = objMatch(0).submatches(0)If Len(strMatch) > 0 TheniLoc = VBA.InStrRev(strTxt, strMatch)Cells(i, 4).Characters(iLoc, Len(strTxt) - iLoc + 1).Font.Color = vbRedEnd IfEnd IfNext iEnd WithSet objRegExp = NothingSet 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 ObjectDim objMatch As ObjectDim strMatch As StringDim iLoc As Integer, strTxt As StringarrData = [a1].CurrentRegionActiveSheet.Columns(4).Font.Color = vbNoneSet 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 TheniLoc = objMatch(2).firstindex + 1Cells(i, 4).Characters(iLoc, Len(strTxt) - iLoc + 1).Font.Color = vbRedEnd IfNext iEnd WithSet objRegExp = NothingSet objMatch = Nothing
End Sub
【代码解析】
第15行代码判断匹配成功的数量是否超过两个。
第16行代码代码使用第3个匹配组（objMatch(2)）的firstindex属性获取字符起始位置，由于正则对象中编号都是0开始的，所以需要加1才能应用于第17行代码中。