Как найти текстовые строки (в Word), используя двумерный массив

Question

У меня есть двумерный массив, состоящий из "проблемных" слов и фраз в первом измерении и комментариев, которые я часто делаю во втором измерении.Кажется, я растерялся из-за того, как выбрать текст, который соответствует первому измерению, и добавить комментарий, используя текст из второго измерения.Есть идеи?

Sub findtrouble()
Dim i As Integer
Dim j As Integer
Dim oRng As Word.Range



Dim MyArray(1, 4) As String
MyArray(0, 0) = "Trouble0"
MyArray(0, 1) = "Trouble1"
MyArray(0, 2) = "Trouble2"
MyArray(0, 3) = "Trouble3"

MyArray(1, 0) = "Comment0"
MyArray(1, 1) = "Comment1"
MyArray(1, 2) = "Comment2"
MyArray(1, 3) = "Comment3"



For j = 0 To 4
        Set oRng = ActiveDocument.Range
        With oRng.Find
            .ClearAllFuzzyOptions
            .ClearFormatting
            .Text = MyArray(0, j)
        While .Execute
            oRng.Select
            ActiveDocument.Comments.Add oRng, MyArray(1, j)    
        Wend
    End With
    Debug.Print "Find: " & MyArray(0, j) & " add cmt box w/ "; MyArray(1, j)
Next j

End Sub

Answer 1

Код в вопросе вставляет один комментарий для меня, но это все.Это потому что oRng не сбрасывается.Сравните код в вопросе с приведенным ниже.

В этом коде после успешного выполнения Find.Execute и добавления комментария диапазон свернут до конечной точки ( после найденного термина), затемконец продлен до конца документа.Таким образом, в следующий раз при поиске термина он будет выглядеть только в том, что следует за первым термином.

Также важно при циклическом поиске в Find установить Find.Wrap в wdFindStop, чтобы не входить в "бесконечный цикл "(чтобы Find не начинался снова в верхней части документа).

Sub findtrouble()
Dim i As Integer
Dim j As Integer
Dim oRng As Word.Range

Dim MyArray(1, 4) As String
MyArray(0, 0) = "Trouble0"
MyArray(0, 1) = "Trouble1"
MyArray(0, 2) = "Trouble2"
MyArray(0, 3) = "Trouble3"

MyArray(1, 0) = "Comment0"
MyArray(1, 1) = "Comment1"
MyArray(1, 2) = "Comment2"
MyArray(1, 3) = "Comment3"

For j = 0 To 4
        Set oRng = ActiveDocument.Content
        With oRng.Find
            .ClearAllFuzzyOptions
            .ClearFormatting
            .text = MyArray(0, j)
            .wrap = wdFindStop
            While .Execute
                oRng.Select
                ActiveDocument.Comments.Add oRng, MyArray(1, j)
                oRng.Collapse wdCollapseEnd
                oRng.End = ActiveDocument.content.End
            Wend
        End With
    Debug.Print "Find: " & MyArray(0, j) & " add cmt box w/ "; MyArray(1, j)
Next j

End Sub

Answer 2

Согласно комментарию @Cindy Meisters опубликованный код работает (даже с ошибкой индексации в цикле for).Код ниже переписан для использования scripting.dictionary

Sub testfindtrouble()
    findtrouble ActiveDocument.Range
End Sub
Sub findtrouble(this_range As Word.Range)
Dim my_lookup       As scripting.Dictionary
Dim my_troubles     As Variant
Dim my_trouble      As Variant
Dim my_range        As Word.Range

' see /10894331/kak-udalit-razdel-s-pomoschy-excel-vba-dlya-sozdaniya-tekstovogo-dokumentacomment93559248_53322166
    Set my_lookup = New scripting.Dictionary

    With my_lookup

        .Add key:="Trouble0", item:="Comment0"
        .Add key:="Trouble1", item:="Comment1"
        .Add key:="Trouble2", item:="Comment2"
        .Add key:="Trouble3", item:="Comment3"

    End With

    my_troubles = my_lookup.Keys

    ' Avoid the off by 1 error (j=0 to 4 is 5 items not the 4 you declared in the array
    For Each my_trouble In my_troubles

        Set my_range = this_range.Duplicate

        With my_range

            With .Find

                .ClearAllFuzzyOptions
                .ClearFormatting
                .text = my_trouble
                .Execute

            End With

            Do While .Find.Found

                 Debug.Print "Find: " & my_trouble & " add cmt box w/ "; my_lookup.item(my_trouble)
                .Comments.Add .Duplicate, my_lookup.item(my_trouble)
                .Collapse Direction:=wdCollapseEnd
                .Move unit:=wdCharacter, Count:=1
                .Find.Execute

            Loop

        End With

    Next

End Sub