正则表达式Word宏,在一个范围内找到两个单词,然后将这些单词斜体化?

pav*_*ja2 6 regex search vba word-vba

所以,我刚刚开始理解正则表达式,我发现学习曲线相当陡峭.但是,stackoverflow在我的实验过程中非常有用.我想写一个特定的单词宏,但我还没有想出办法.我希望能够在一个文档中找到彼此10个左右的单词中的两个单词,然后将这些单词用斜体字表示,如果这些单词的间隔超过10个单词或者顺序不同,我希望宏不要斜体那些话.

我一直在使用以下正则表达式:

\bPanama\W+(?:\w+\W+){0,10}?Canal\b
Run Code Online (Sandbox Code Playgroud)

然而,它只允许我操纵整个字符串作为一个整体,包括其间的随机单词.此外,.Replace函数只允许我用不同的字符串替换该字符串而不更改格式样式.

有经验的人是否知道如何使这项工作?它甚至可以吗?


编辑:这是我到目前为止.我有两个问题.首先,我不知道如何仅从匹配的正则表达式中选择单词"Panama"和"Canal",并仅替换那些单词(而不是中间单词).其次,我只是不知道如何替换与不同格式匹配的正则表达式,只有不同的文本字符串 - 可能只是因为对单词宏不熟悉.

Sub RegText()
Dim re As regExp
Dim para As Paragraph
Dim rng As Range
Set re = New regExp
re.Pattern = "\bPanama\W+(?:\w+\W+){0,10}?Canal\b"
re.IgnoreCase = True
re.Global = True
For Each para In ActiveDocument.Paragraphs
  Set rng = para.Range
  rng.MoveEnd unit:=wdCharacter, Count:=-1
  Text$ = rng.Text + "Modified"
  rng.Text = re.Replace(rng.Text, Text$)
Next para
End Sub
Run Code Online (Sandbox Code Playgroud)

好的,感谢蒂姆·威廉姆斯的帮助下面我得到了以下解决方案,它在某些方面有点笨拙并且它绝不是纯粹的正则表达式,但它确实完成了工作.如果有人有更好的解决方案或想法如何解决这个问题,我会很高兴听到它.再一次,我的粗暴强迫搜索和替换功能的变化是一个有点令人尴尬的粗糙,但至少它的工作原理...

Sub RegText()
Dim re As regExp
Dim para As Paragraph
Dim rng As Range
Dim txt As String
Dim allmatches As MatchCollection, m As match
Set re = New regExp
re.pattern = "\bPanama\W+(?:\w+\W+){0,13}?Canal\b"
re.IgnoreCase = True
re.Global = True
For Each para In ActiveDocument.Paragraphs

  txt = para.Range.Text

  'any match?
  If re.Test(txt) Then
    'get all matches
    Set allmatches = re.Execute(txt)
    'look at each match and hilight corresponding range
    For Each m In allmatches
        Debug.Print m.Value, m.FirstIndex, m.Length
        Set rng = para.Range
        rng.Collapse wdCollapseStart
        rng.MoveStart wdCharacter, m.FirstIndex
        rng.MoveEnd wdCharacter, m.Length
        rng.Font.ColorIndex = wdOrange
    Next m
  End If

Next para

Selection.Find.ClearFormatting
Selection.Find.Font.ColorIndex = wdOrange
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Font.Italic = True
With Selection.Find
    .Text = "Panama"
    .Replacement.Text = "Panama"
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Font.ColorIndex = wdOrange
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Font.Italic = True
With Selection.Find
    .Text = "Canal"
    .Replacement.Text = "Canal"
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

Selection.Find.ClearFormatting
Selection.Find.Font.ColorIndex = wdOrange
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Font.ColorIndex = wdBlack
With Selection.Find
    .Text = ""
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
Run Code Online (Sandbox Code Playgroud)

Tim*_*ams 6

作为一个体面的Word程序员,我还有很长的路要走,但这可能会让你开始.

编辑:更新以包括参数化版本.

Sub Tester()

    HighlightIfClose ActiveDocument, "panama", "canal", wdBrightGreen
    HighlightIfClose ActiveDocument, "red", "socks", wdRed

End Sub


Sub HighlightIfClose(doc As Document, word1 As String, _
                     word2 As String, clrIndex As WdColorIndex)
    Dim re As RegExp
    Dim para As Paragraph
    Dim rng As Range
    Dim txt As String
    Dim allmatches As MatchCollection, m As match

    Set re = New RegExp
    re.Pattern = "\b" & word1 & "\W+(?:\w+\W+){0,10}?" _
                 & word2 & "\b"
    re.IgnoreCase = True
    re.Global = True

    For Each para In ActiveDocument.Paragraphs

      txt = para.Range.Text

      'any match?
      If re.Test(txt) Then
        'get all matches
        Set allmatches = re.Execute(txt)
        'look at each match and hilight corresponding range
        For Each m In allmatches
            Debug.Print m.Value, m.FirstIndex, m.Length
            Set rng = para.Range
            rng.Collapse wdCollapseStart
            rng.MoveStart wdCharacter, m.FirstIndex
            rng.MoveEnd wdCharacter, Len(word1)
            rng.HighlightColorIndex = clrIndex
            Set rng = para.Range
            rng.Collapse wdCollapseStart
            rng.MoveStart wdCharacter, m.FirstIndex + (m.Length - Len(word2))
            rng.MoveEnd wdCharacter, Len(word2)
            rng.HighlightColorIndex = clrIndex
        Next m
      End If

    Next para

End Sub
Run Code Online (Sandbox Code Playgroud)