问题
As an alternative to my previous question regarding range.find, I am trying Selection.find.
I have found the occurrence of an abbreviation inside a table. I want to continue my search from the location of that result.
However, when I get the range and select it, the Selection starts from the beginning of the row.
How can I restrict it to be from the previous occurrence?
current code:
Private Sub cmdFindNextAbbr_Click()
Dim myRange As range
Dim Word, findText As String
Dim chkAbbrLast, chkAbbrFullLast, fsCountExt, NextAbbrStart, NextAbbrStartTemp, NextAbbrEndTemp As Integer
Dim firstOccEnd As Long
Dim abr, abrText, srText As String
Dim abrtype, ig, absCounter As Integer
'CREATING DICTONARY for Selected Items
abr = lstAbbreviations.List(selAbbrIndex, 0)
abrText = lstAbbreviations.List(selAbbrIndex, 1)
abrtype = lstAbbreviations.List(selAbbrIndex, 4)
chkAbbrLast = 0
chkAbbrFullLast = 0
If NextAbbrEnd = 0 Then
NextAbbrEnd = abbrFirstOccEnd
NextAbbrStart = 0
End If
fnCountAbr = fnCountAbr + 1
' checking for full text and abbreviations
vFindText = abrText & "," & abrText & "s," & abr & "," & abr & "s"
vFindText = Split(vFindText, ",")
aCount = 0
For ig = LBound(vFindText) To UBound(vFindText)
Set myRange = ActiveDocument.range(Start:=NextAbbrEnd + 1, End:=ActiveDocument.range.End)
absCounter = 0
srText = vFindText(ig)
If InStr(srText, abrText) > 0 Then
bMatchCase = False
ElseIf InStr(srText, abr) > 0 Then
bMatchCase = True
End If
Dim cached As Long
cached = ActiveDocument.range.End
myRange.Find.ClearFormatting
myRange.Select
Selection.Find.ClearFormatting
Do While Selection.Find.Execute( _
findText:=srText, _
MatchCase:=bMatchCase, _
Wrap:=wdFindStop, _
MatchWholeWord:=True _
)
' if the found text starts earlier, set its location as first location
If Selection.End <> abbrFirstOccEnd Then
If NextAbbrStartTemp = 0 Or Selection.Start < NextAbbrStartTemp Then
NextAbbrStartTemp = Selection.Start
End If
End If
'check for full term and abbreviation
fsCountExt = Len(abrText & "s (" & abr & "s)")
If UCase(Selection.Text) = UCase(abrText & "s (" & abr & "s)") Then
txtNew = abr & "s"
If Selection.End = NextAbbrStartTemp + fsCountExt Then
NextAbbrEndTemp = Selection.End
NextAbbrStartTemp = Selection.Start
End If
GoTo ContLoop
Else
fsCountExt = Len(abrText & " (" & abr & ")")
Selection.End = Selection.Start + fsCountExt
End If
If UCase(Selection.Text) = UCase(abrText & " (" & abr & ")") Then
txtNew = abr
If Selection.End = NextAbbrStartTemp + fsCountExt Then
NextAbbrEndTemp = Selection.End
NextAbbrStartTemp = Selection.Start
End If
GoTo ContLoop
End If
'check for full term only
fsCountExt = Len(abrText & "s")
Selection.End = Selection.Start + fsCountExt
If UCase(Selection.Text) = UCase(abrText & "s") Then
txtNew = abr & "s"
If Selection.End = NextAbbrStartTemp + fsCountExt Then
NextAbbrEndTemp = Selection.End
NextAbbrStartTemp = Selection.Start
End If
GoTo ContLoop
Else
fsCountExt = Len(abrText)
Selection.End = Selection.Start + fsCountExt
End If
If UCase(Selection.Text) = UCase(abrText) Then
txtNew = abr
If Selection.End = NextAbbrStartTemp + fsCountExt Then
NextAbbrEndTemp = Selection.End
NextAbbrStartTemp = Selection.Start
End If
GoTo ContLoop
End If
'check for only abbreviation
fsCountExt = Len(abr & "s")
Selection.End = Selection.Start + fsCountExt
If UCase(Selection.Text) = UCase(abr & "s") Then
txtNew = abr & "s"
If Selection.End = NextAbbrStartTemp + fsCountExt Then
NextAbbrEndTemp = Selection.End
NextAbbrStartTemp = Selection.Start
End If
GoTo ContLoop
Else
fsCountExt = Len(abr)
Selection.End = Selection.Start + fsCountExt
End If
If UCase(Selection.Text) = UCase(abr) Then
txtNew = abr
If Selection.End = NextAbbrStartTemp + fsCountExt Then
NextAbbrEndTemp = Selection.End
NextAbbrStartTemp = Selection.Start
End If
GoTo ContLoop
End If
If absCounter > 2 Then GoTo ContSearch
absCounter = absCounter + 1
ContLoop:
Loop
ContSearch:
Selection.Start = Selection.Start + Len(Selection.Find.Text) + 1
Selection.End = cached
Next ig
'MsgBox "No further occurrences found"
ExitNextSub:
NextAbbrStart = NextAbbrStartTemp
NextAbbrEnd = NextAbbrEndTemp
myRange.Start = NextAbbrStart
myRange.End = NextAbbrEnd
myRange.Select
Application.ScreenRefresh
End Sub
While debugging, I see the below values after myRange.Select. While checking the document. I see that the text from the beginning of the row is selected
myRange.Start : 18838
Selection.Start : 18216
回答1:
Use a (temporary) bookmark to note where you want to restart. Do not try to rely on the Start and End properties. Those are not reliable.
When Find could end up in a table and the found term will continue to exist in that position, searching from that point onwards to the end (or beginning) of the document will automatically include the entire row. You can see this as a user if you click in a cell then hold Shift and press right-arrow until the selection moves beyond the table.
In such a situation you need to test whether the found Range is in a table. If it is, you need to continue the Find loop cell-by-cell until the found Range is no longer in a table.
The following code demonstrates the principle. It uses a Range object, not Selection, as that's easier and more predictable to control. It's also very simplified in order to concentrate on the principle of looping a table cell-by-cell which can be a bit mind-boggling. (The Debug.Print is just in there for keeping track while testing.)
Whether the Find is successful is stored in the boolean variable bFound. In the case of success the found Range is tested for being in a table. (Note that you could also use rngFind.Information(wdWithinTable).) If it is, the Range is collapsed so that the found term is "outside" it, then the Range extended to the end of the cell.
Find is repeated in the loop until no more "hits" are found in that cell. The Range is then moved to the next cell and Find repeated until the found Range is no longer in a table. Then Find reverts to the "normal" process, in a loop, until no more instances of the search term are found.
Sub FindLoopThroughTables()
Dim sFindTerm As String
Dim doc As Word.Document
Dim rngFind As Word.Range
Dim cel As Word.Cell
Dim bFound As Boolean
Set doc = ActiveDocument
Set rngFind = doc.content
rngFind.Find.wrap = wdFindStop
sFindTerm = "the"
bFound = rngFind.Find.Execute(sFindTerm)
Do While bFound
Debug.Print rngFind.Start
If rngFind.Tables.Count > 0 Then
Do While bFound And rngFind.Tables.Count > 0
Set cel = rngFind.Cells(1)
rngFind.Collapse wdCollapseEnd
rngFind.End = cel.Range.End - 1
bFound = rngFind.Find.Execute(sFindTerm)
If bFound Then
Debug.Print rngFind.Start & "in table"
Else
rngFind.MoveStart wdCell, 1
Set cel = rngFind.Cells(1)
rngFind.End = cel.Range.End
bFound = rngFind.Find.Execute(sFindTerm)
End If
Loop
Else
rngFind.Collapse wdCollapseEnd
rngFind.End = doc.content.End
bFound = rngFind.Find.Execute(sFindTerm)
End If
Loop
End Sub
来源：https://stackoverflow.com/questions/51925805/vba-how-to-start-a-selection-halfway-through-the-text-in-a-table