Word VBA提取包含两个指定单词的句子问题求助

原代码存在的问题 #

• 通配符表达式强制要求目标单词前后带空格，会漏掉句子开头/结尾的单词（如As we start或end as.）
• 未限制匹配范围在单个句子内，可能跨句号匹配多个句子
• 未处理重复提取同一句子的情况（若一个句子内存在多组目标单词，会重复添加）

修正后的代码 #

Sub FindWordCopySentenceToSecondDocument()
    ' 当前文档对象
    Dim aRange As Range: Set aRange = ActiveDocument.Range
    ' 新建结果文档
    Dim NewDocument As Document: Set NewDocument = Documents.Add
    Dim docRng As Range: Set docRng = NewDocument.Range
    
    ' 可自定义的目标单词对
    Dim strWord1 As String: strWord1 = "as"
    Dim strWord2 As String: strWord2 = "as"
    
    ' 记录已处理的句子范围，避免重复添加
    Dim processedRanges As Collection: Set processedRanges = New Collection
    
    With aRange.Find
        .Text = "<" & strWord1 & ">[!.]@<" & strWord2 & ">"
        .ClearFormatting
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchFuzzy = False
        .MatchWildcards = True
        .Wrap = wdFindStop ' 避免循环查找
        
        Do While .Execute
            ' 扩展到完整句子
            aRange.Expand Unit:=wdSentence
            
            ' 检查当前句子是否已处理过
            Dim isDuplicate As Boolean: isDuplicate = False
            Dim rng As Variant
            For Each rng In processedRanges
                If aRange.Start = rng.Start And aRange.End = rng.End Then
                    isDuplicate = True
                    Exit For
                End If
            Next rng
            
            If Not isDuplicate Then
                ' 将格式化文本复制到新文档
                docRng.Characters.Last.FormattedText = aRange.FormattedText
                docRng.InsertParagraphAfter
                ' 记录已处理的句子范围
                processedRanges.Add aRange.Duplicate
            End If
            
            ' 折叠范围，继续查找下一个匹配
            aRange.Collapse wdCollapseEnd
        Loop
    End With
    
    ' 释放对象
    Set aRange = Nothing
    Set NewDocument = Nothing
    Set docRng = Nothing
    Set processedRanges = Nothing
End Sub

关键改动说明 #

• 通配符优化：用<单词>匹配完整单词（自动排除ass这类部分匹配），[!.]@确保两个单词之间没有句号，强制匹配范围在单个句子内
• 支持自定义单词：通过strWord1和strWord2可快速替换目标单词对（如改成father和son）
• 去重处理：用集合记录已提取的句子范围，避免重复添加同一句子
• 查找终止设置：添加.Wrap = wdFindStop防止无限循环

内容的提问来源于stack exchange，提问作者Ziad El Hachem