VBA Regex 仅返回最后一个匹配项

Question

我正在尝试查找在括号内的引号中找到的 所有 项（“要找到的项”），无论括号中是否有其他单词（这也是一个“要找到的条款”）。

我的 ActiveDocument 的内容是：

This is a ("Test") and another (second "Test2")

我的代码是：

Dim regEx As Object
Dim matchCollection As Object
Dim extractedString As String
Dim match As Object
Dim RealQ
Dim n As Integer

RealQ = Chr(34)

Set regEx = CreateObject("VBScript.RegExp")
With regEx
  .IgnoreCase = IgnoreCase
  .Global = True
  .MultiLine = True
  .Pattern = "\(.*" & RealQ & "(.*)" & RealQ & "\)"
End With

Set matchCollection = regEx.Execute(ActiveDocument.Content.Text)

extractedString = ""

For Each match In matchCollection

    Debug.Print (match.submatches(0))

Next

上面只找到最后一次出现，即“Test2”。我错过了什么？

非常感谢！！

Answer 1

您不需要 RegEx！这一切都可以通过 Word 自己的通配符查找工具来完成。例如：

Sub Demo()
Application.ScreenUpdating = False
Dim StrFnd As String, i As Long
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "\(*[^34][!\)]@[^34]*\)"
    .Replacement.Text = ""
    .MatchWildcards = True
    .Wrap = wdFindStop
    .Forward = True
    .Format = False
    .Execute
  End With
  Do While .Find.Found
    i = i + 1
    StrFnd = StrFnd & vbCr & Split(.Text, """")(1)
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
End With
Application.ScreenUpdating = True
MsgBox i & " instances found:" & StrFnd
End Sub

更复杂的代码也可用于处理带有智能引号的内容。

Answer 2

您可以在 Word 本身中使用通配符搜索来完成此任务，而无需调用 Regexp。下面的代码将返回范围对象的 scripting.dictionary，您可以从中提取文本，或者通过非常小的调整返回捕获的文本。键功能允许您定义要使用的括号集以及要用于引号的字符。在下面的测试用例中，我使用了 word 中的智能引号字符。

我使用的测试文本是

Blah blah blah (blah "Text 1" blah) blah blah blah Blah blah blah (blah “Text 2” blah) Blah blah blah (blah “Text 3” blah) Blah blah blah (blah “Text 4” blah)

输出为

Text 2
Text 3
Text 4

因为第一组引号不是智能引号。您不会说您是否只需要提取文本或查找文本，然后以某种方式在 Word 文档中对其进行处理，因此我的第一个选择是返回找到的文本的 Word.Ranges。获取文本的调整在函数的 cmets 中提供。

下面的代码不会对神奇的 RubberDuck 插件进行任何代码检查。

Public Sub testGetTextInQuotesInBrackets()

Dim myTexts As Scripting.Dictionary

    Set myTexts = _
        GetTextInQuotesInBrackets _
        ( _
            "(,)", _
            ChrW$(&H201C) & "," & ChrW$(&H201D), _
            ActiveDocument.StoryRanges(wdMainTextStory) _
        )

    Dim myItem As Variant
    For Each myItem In myTexts

        Debug.Print myTexts.Item(myItem).Text
        ' if just the text was collected
        'Debug.Print myItem

    Next

End Sub

'@Description("Returns a scripting.Dictionary of long vs word.range objects)
Function GetTextInQuotesInBrackets _
( _
    ByVal ipBrackets As String, _
    ByVal ipQuotes As String, _
    ByRef ipRange As Word.Range _
) As Scripting.Dictionary


    Dim myTextRanges As Scripting.Dictionary
    Set myTextRanges = New Scripting.Dictionary

    Dim myBrackets As Variant
    myBrackets = Split(ipBrackets, ",")

    Dim myQuotes As Variant
    myQuotes = Split(ipQuotes, ",")

    With ipRange

        With .Find

            .ClearFormatting
            .Text = "[" & myBrackets(0) & "]*[" & myQuotes(0) & "]*[" & myQuotes(1) & "]" ' is there any need to process the following closing bracket
            .MatchWildcards = True
            .Wrap = wdFindStop

        End With

        Do While .Find.Execute

            Dim myFoundRange As Word.Range
            Set myFoundRange = .Duplicate
            With myFoundRange

                .MoveStartUntil cset:=myQuotes(0)
                ' Select the text within the quotes
                .MoveStart Count:=1
                .MoveEnd Count:=-1


            End With

            myTextRanges.Add myTextRanges.Count, myFoundRange
            ' Alternatively, if you just need the text
            'myTextRanges.add myTextRanges.count, myFoundRange.Text
            .Start = myFoundRange.End + 2
            .End = ipRange.End

        Loop

    End With

    Set GetTextInQuotesInBrackets = myTextRanges

End Function