Word VBA使用正则表达式定位匹配文本的一个坑

popy32

这是摘自孙兴华老师在Word VBA视频教程中的笔记，作用是利用正则表达式匹配身份证号。

Sub 正则搞定身份证号()
    Set 文档 = Application.ActiveDocument
    '第2季 20.2.1
    '给对象指定正则表达式对象
    'CreateObject函数用于创建各种外部对象，对象的完整名称就是参数
    Set 正则 = CreateObject("vbscript.regexp")
    'Pattern后面写正则表达式
    正则.Pattern = "[1-9]\d{5}(18|19|20|(3\d))\d{2}((0[1-9])|(1[0-2]))(([0-2][1-9])|10|20|30|31)\d{3}[0-9Xx]"
    'Global值为True返回所有符合要求的结果，反之只返回第一个符合要求的结果
    正则.Global = True
    'Execute(字符串)
    Set 结果集合 = 正则.Execute(文档.Range.Text)
    For Each 身份证号 In 结果集合
        'MsgBox 身份证号
        'firstindex代表第一个下标，length代表总长度
        Set 获取 = 文档.Range(身份证号.firstindex, 身份证号.firstindex + 身份证号.Length)
        获取.Font.ColorIndex = wdBlue
        获取.Font.Bold = True
End Sub

匹配到了字串需要定位在文中的位置，但是在多段文本中匹配就失效了，“文档.Range”函数并没有返回正确的区间给 “获取”，每次离目标字符总是相隔几个。后来看到这个帖子才豁然开朗。

Sub Word文档中查找替换()
    Dim col As New Collection, k&
    Dim i%, mt, oRang As Range, n%, m%
    With CreateObject("vbscript.regexp")
        .Pattern = "" '这里各显其能输入正则表达式（根据自己的需求）
        .Global = True:.IgnoreCase = False:.MultiLine = True
        For Each i In ActiveDocument.Paragraphs
            For Each mt In .Execute(i.Range.Text)
                k = k + 1
                m = mt.FirstIndex: n = mt.Length
                Set oRang = ActiveDocument.Range(i.Range.Start + m, i.Range.Start + m + n)
                col.Add oRang, CStr(k)