Question

我正在尝试在Word文档中搜索特定字符串的出现。该代码应仅在目录之后搜索。我的完整代码如下：

Private Sub cmdFindNextAbbr_Click()

    Dim myRange As range

    'CREATING DICTONARY for Selected Items
    If firstClickAbr = True Then

        txtNew = ""

        abSelIndex = 0
        Set abSel = CreateObject("scripting.dictionary")
        Set abSelFirstStart = CreateObject("scripting.dictionary")

        firstClickAbr = False
        iAbbr = 0
        For x = 0 To lstAbbreviations.ListCount - 1
            If lstAbbreviations.Selected(x) = True Then
                If Not abSel.Exists(lstAbbreviations.List(x, 1)) Then
                    abSel.Add lstAbbreviations.List(x, 0), lstAbbreviations.List(x, 1)
                    abSelFirstStart.Add lstAbbreviations.List(x, 0), lstAbbreviations.List(x, 5)
                End If
            End If
        Next x
    End If

    Dim Word, findText As String
    Dim chkAbbrLast, fsCountExt, firstOccEnd As Integer

    Do While abSelIndex < abSel.count
        chkAbbrLast = 0

        Set myRange = ActiveDocument.Content

        If txtNew <> abSel.keys()(abSelIndex) Then
            fnCountAbr = 0
            locInteger = abbrTableEnd
        End If

        firstOccEnd = abSelFirstStart.items()(abSelIndex) + Len(abSel.items()(abSelIndex) & " (" & abSel.keys()(abSelIndex) & ")")
        fnCountAbr = fnCountAbr + 1
        Word = abSel.keys()(abSelIndex)

        'initially search for full text
        findText = abSel.items()(abSelIndex)

        myRange.Start = locInteger
        myRange.Find.ClearFormatting
        Do While myRange.Find.Execute( _
                    findText:=findText, _
                    MatchCase:=False, _
                    MatchWholeWord:=True, _
                    Wrap:=wdFindStop, _
                    Forward:=True _
                    )

            If Left(myRange.Style, 7) <> "Heading" Then
                If abSelFirstStart.items()(abSelIndex) <> myRange.Start Then 'ignore the first occurrence

                    locInteger = myRange.End
                    tCount = tCount + 1

                    'check for full term and abbreviation
                    fsCountExt = Len(abSel.items()(abSelIndex) & "s (" & abSel.keys()(abSelIndex) & "s)")
                    myRange.End = myRange.Start + fsCountExt

                    If InStr(UCase(myRange.Text), UCase(abSel.items()(abSelIndex) & "s (" & abSel.keys()(abSelIndex) & "s)")) > 0 Then
                        txtNew = abSel.keys()(abSelIndex) & "s"
                        myRange.Select
                        Exit Sub
                    Else
                        fsCountExt = Len(abSel.items()(abSelIndex) & " (" & abSel.keys()(abSelIndex) & ")")
                        myRange.End = myRange.Start + fsCountExt
                    End If

                    If InStr(UCase(myRange.Text), UCase(abSel.items()(abSelIndex) & " (" & abSel.keys()(abSelIndex) & ")")) > 0 Then
                        txtNew = abSel.keys()(abSelIndex)
                        myRange.Select
                        Exit Sub
                    End If

                    'check for full term only
                    fsCountExt = Len(abSel.items()(abSelIndex) & "s (" & abSel.keys()(abSelIndex) & "s)")
                    myRange.End = myRange.Start + fsCountExt

                    If InStr(UCase(myRange.Text), UCase(abSel.items()(abSelIndex) & "s")) > 0 Then
                        txtNew = abSel.keys()(abSelIndex) & "s"
                        myRange.Select
                        Exit Sub
                    Else
                        fsCountExt = Len(abSel.items()(abSelIndex))
                        myRange.End = myRange.Start + fsCountExt
                    End If

                    If InStr(UCase(myRange.Text), UCase(abSel.items()(abSelIndex))) > 0 Then
                        txtNew = abSel.keys()(abSelIndex)
                        myRange.Select
                        Exit Sub
                    End If
                End If
            End If
                chkAbbrLast = chkAbbrLast + 1     ' check to prevent infinite loop
            myRange.End = ActiveDocument.Content.End
            If chkAbbrLast > 2 Then
                Exit Do
            End If
        Loop

        'now search for abbreviation
        findText = abSel.keys()(abSelIndex)
        chkAbbrLast = 0
        myRange.Start = locInteger
        myRange.Find.ClearFormatting
        Do While myRange.Find.Execute( _
                    findText:=findText, _
                    MatchCase:=True, _
                    MatchWholeWord:=True _
                    )

            If Left(myRange.Style, 7) <> "Heading" And myRange.Start > firstOccEnd Then

                If abbIgnoreList.contains(myRange.Start) Then ' skip if match is in ignore list
                    If abSelIndex = abSel.count - 1 Then
                        chkAbbrLast = chkAbbrLast + 1   ' check to prevent infinite loop
                    End If
                    locInteger = myRange.End
                Else
                    locInteger = myRange.End
                    tCount = tCount + 1

                    fsCountExt = Len(abSel.keys()(abSelIndex) & "s")
                    myRange.End = myRange.Start + fsCountExt

                    If InStr(UCase(myRange.Text), UCase(abSel.keys()(abSelIndex) & "s")) > 0 Then
                        txtNew = abSel.keys()(abSelIndex) & "s"
                        myRange.Select
                        Exit Sub
                    Else
                        fsCountExt = Len(abSel.keys()(abSelIndex))
                        myRange.End = myRange.Start + fsCountExt
                    End If

                    If InStr(UCase(myRange.Text), UCase(abSel.keys()(abSelIndex))) > 0 Then
                        txtNew = abSel.keys()(abSelIndex)
                        myRange.Select
                        Exit Sub
                    End If
                End If

            End If
                chkAbbrLast = chkAbbrLast + 1     ' check to prevent infinite loop
            If chkAbbrLast > 2 Then
                Exit Do
            End If
            myRange.End = ActiveDocument.Content.End

        Loop

        'loop to next/first item
        If abSelIndex <= abSel.count - 1 Then
            abSelIndex = abSelIndex + 1
        Else
            abSelIndex = 0 ' start again at beginning
        End If
    Loop

    MsgBox "No further occurrences found"
End Sub

ToCEnd是4085。

我能够找到第一个结果。当我单击调用相同方法的“查找下一个”按钮时，我具有以下值：

myRange.Start : 18046
myRange.End : 21467

但是，在.Find.Execute之后，我具有以下值：

myRange.Start : 18022
myRange.End : 18046

为什么找到的文本在我之前定义的起点处结束？ Start和End之间的区别是我的字符串长度24

编辑：我已经添加了完整的代码。

我在代码中所做的是查找用户可以替换的文本。替换是从另一个按钮触发的。

在Find Next按钮事件中，我验证结果，将范围的结尾存储到变量中并退出子项。下次单击时，我正尝试从存储的位置开始搜索。

我更新了代码，使其与this link上的代码相似，但我仍然有相同的行为。

Answer 1

您显然想遍历找到的实例。为此，您可以使用如下代码：

Sub Demo()
Application.ScreenUpdating = False
Dim i As Long
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 = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    .Execute
  End With
  Do While .Find.Found
    i = i + 1
    'insert code to do something with whatever's been found here
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
End With
Application.ScreenUpdating = True
MsgBox i & " instances found."
End Sub

为什么range.find这样搜索？

1 个答案: