如何从当前选择开始在文档中查找单词

Question

我有一段代码在文档中从当前选择到结尾搜索单词。这样做的目的是在下次运行时找到下一个实例，依此类推。

它可以正常工作，直到它在表格中找到一个单词，此时它不会在该条目之后找到任何内容。我需要能够在表格和文本中找到单词。它还作为用户表单中的函数运行（无模式运行），等待用户输入然后提供不同的单词，循环并根据用户输入执行操作。所以我不相信我可以在查找部分运行我的其他代码（尽管我很高兴得到纠正）。

Sub test1()

Dim list() As String
Dim wrd As String
Dim mrk As Integer

wrd = "ABC" 'Get next word from list

'set range to search as from current selection (previously found) to end of document
Dim DocRng
Set DocRng = ActiveDocument.Range(Start:=Selection.End, End:=ActiveDocument.Content.End)

mrk = Selection.End 'Mark end of previously found instance (current selection)

With DocRng.Find 'Find next instance of word and select it
     .Text = wrd
     .MatchCase = True
     .Forward = True
     .Execute
     DocRng.Select
End With

If Selection.End = mrk Then 'If selection hasn't changed inform user and go to start of document
    MsgBox ("Reached end of document.")
    Selection.GoTo What:=wdGoToLine, Which:=wdGoToAbsolute, Count:=0
End If

tmp = Selection.Text 'Save currently selected text

End Sub

如何让它找到表格后面的条目？

Answer 1

您可以在查找/替换循环中运行其他代码，使用如下代码：

Sub Demo()
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = InputBox("What is the Text to Find")
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchCase = True
    .MatchWholeWord = True
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    .Execute
  End With
  Do While .Find.Found
    .Select
    Select Case MsgBox("Replace this one?", vbYesNoCancel)
      Case vbCancel: Exit Sub
      Case vbYes: .Text = InputBox("Replacement text")
      Case Else
    End Select
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
End With
End Sub

此类代码不受表格影响。

Answer 2

通过搜索整个文档（或指定范围）并将每个实例的位置存储在一个数组中，然后您可以将这些位置与当前选择进行比较，并选择当前选择之后的实例。

Function search()

Dim list() As String
Dim Wrd As String
Dim k As Integer
Dim Nfound As Boolean

Dim Def As String
Dim location() As String

'Search document and get locations of each instance of a word

Wrd = "ABC" 'Get next word from list
Def = "Alphabet"
k = 1

Dim DocRng
Set DocRng = ActiveDocument.Content 'search whole document

With DocRng.find
     .Text = Wrd
     .MatchCase = True

    Do While .Execute 'For each entry found, store start and end to array
        ReDim Preserve location(2, k)
        location(1, k) = DocRng.Start
        location(2, k) = DocRng.End
        k = k + 1
    Loop

End With

'Compare the found locations against the current selection and select the first instance after current selection

Nfound = True 'Set as not found until it is found

    j = Selection.End 'mark current cursor location

    For k = 1 To UBound(location, 2)
        If location(1, k) > j + Len(Def) Then '+ Len(Def) accounts for changes to text
            ActiveDocument.Range(Start:=location(1, k), End:=location(2, k)).Select
            Nfound = False
            Exit For
        End If
    Next

    If Nfound Then 'if not found got to first instance found
        k = 1
        ActiveDocument.Range(Start:=location(1, k), End:=location(2, k)).Select
    End If

End Function