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 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 объектов диапазона, из которых вы можете извлечь текст, или с очень незначительной настройкой просто верните захваченные тексты. Функция key позволяет вам определить, какие наборы скобок вы хотите использовать, а также какие символы вы будете использовать sh для кавычек. В приведенном ниже тестовом примере я использовал символы для умных кавычек в слове.

Я использовал тестовый текст

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 найденного текста. Настройка, позволяющая получить только текст, приведена в комментариях к функции.

Приведенный ниже код не вызывает никаких проверок кода из fantasti c RubberDuck add in.

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