如何使用二维数组查找文本字符串(在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循环中出现索引错误(。下面的代码是相同的重写使用脚本。字典

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