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 https://stackoverflow.com/questions/53317548/how-to-delete-a-section-using-excel-vba-to-create-a-word-document/53322166?noredirect=1#comment93559248_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

如何使用二维数组查找文本字符串（在Word中）

2 个答案: