如何在VBA中将正则匹配的句子设为范围以添加动态超链接？

我想用正则表达式提取文档中包含类似23/25格式的句子，需求是：当匹配到的句子中出现特定单词时，给其中的23/25添加对应不同的超链接。但找到的添加超链接的VBA代码只能使用ActiveDocument.Range（全文范围），导致所有23/25都被添加相同的超链接。请问能否将范围精准限定到正则匹配到的句子？

以下是我编写的不完善代码：

Set objRegex = New RegExp
With objRegex
   .Pattern = "(\d{2}/\d{2})([a-zA-Zé /'/., ]{2,250})"
   .Global = True
   .IgnoreCase = True
Set matches = .Execute(Txte)
For Each fnd In matches
a = fnd.SubMatches.Count
For i = 0 To a - 1
    If InStr(fnd, "cdtional word") Then
        resul = fnd.SubMatches.Item(1)
Set Rng = ActiveDocument.Range{resul}
With Rng.Find
   Do While .Execute(findText:=resul, Forward:=False) = True
       Rng.MoveEndUntil (" ")
       ActiveDocument.Hyperlinks.Add _
       Anchor:=Rng, _
       Address:="https://bla.org/" & resul
       Rng.Collapse wdCollapseStart
   Loop

可以精准限定到正则匹配的句子范围。核心思路是利用正则匹配结果的FirstIndex和Length属性，直接定位文档中对应句子的具体Range，而非在全文中盲目搜索，这样就能只处理目标句子里的XX/XX格式内容。

修正后的代码如下：

Sub AddHyperlinksToTargetMatches()
    Dim objRegex As RegExp
    Dim matches As MatchCollection
    Dim fnd As Match
    Dim targetRange As Range
    Dim numPattern As String
    Dim specificWord As String
    
    ' 配置正则规则和目标关键词
    Set objRegex = New RegExp
    numPattern = "\d{2}/\d{2}" ' 匹配XX/XX格式
    objRegex.Pattern = "(" & numPattern & ")([a-zA-Zé /'., ]{2,250})"
    objRegex.Global = True
    objRegex.IgnoreCase = True
    specificWord = "cdtional word" ' 替换成你的目标特定单词
    
    ' 遍历所有正则匹配结果
    Set matches = objRegex.Execute(ActiveDocument.Content.Text)
    For Each fnd In matches
        ' 检查当前匹配的句子是否包含特定单词
        If InStr(fnd.Value, specificWord) > 0 Then
            ' 精准定位到文档中当前匹配句子的Range
            Set targetRange = ActiveDocument.Range( _
                Start:=fnd.FirstIndex, _
                End:=fnd.FirstIndex + fnd.Length _
            )
            
            ' 在限定的句子范围内搜索XX/XX格式内容
            With targetRange.Find
                .Text = numPattern
                .Forward = True
                .MatchWholeWord = False
                .MatchCase = False
                .Wrap = wdFindStop ' 仅在当前句子范围内查找，不循环全文
                
                Do While .Execute
                    ' 给找到的XX/XX添加对应超链接
                    ActiveDocument.Hyperlinks.Add _
                        Anchor:=targetRange, _
                        Address:="https://bla.org/" & targetRange.Text ' 可根据需求修改链接规则
                    ' 折叠范围，继续查找当前句子内的下一个匹配项
                    targetRange.Collapse wdCollapseEnd
                Loop
            End With
        End If
    Next fnd
    
    ' 释放对象
    Set objRegex = Nothing
    Set matches = Nothing
    Set targetRange = Nothing
End Sub

关键修改说明 #

• 用正则匹配项的FirstIndex和Length直接定位文档中对应句子的Range，避免全文搜索导致的误匹配
• 设置Wrap = wdFindStop，强制查找仅在当前匹配的句子范围内进行
• 移除了原代码中错误的Set Rng = ActiveDocument.Range{resul}写法，改用正确的Range定位逻辑
• 拆分正则模式，让XX/XX的匹配规则更清晰，便于后续单独查找处理

内容的提问来源于Stack Exchange，提问作者Omar Kend