VBA - 如何在 table 中的文本中途开始选择
VBA - How to start a selection halfway through the text in a table
作为关于 range.find
的 previous question 的替代方案,我正在尝试 Selection.find
。
我发现 table 中出现了一个缩写。我想从该结果的位置继续我的搜索。
但是,当我获得范围并 select 它时,选择从行的开头开始。
我怎样才能限制它来自上一次出现?
当前代码:
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
调试时,我在 myRange.Select
后看到以下值。在检查文档时。我看到该行开头的文本是 selected
myRange.Start : 18838
Selection.Start : 18216
使用(临时)书签记下您要重新启动的位置。 不要 尝试依赖 Start
和 End
属性。那些都不靠谱。
当 Find 可能在 table 中结束并且找到的术语将继续存在于该位置时,从该点开始搜索到文档的结尾(或开头)将自动包括整行.如果您在一个单元格中单击然后按住 Shift 键并按向右箭头直到选择超出 table.
,您可以以用户身份看到它
在这种情况下,您需要测试找到的Range是否在table中。如果是,则需要逐个单元格地继续查找循环,直到找到的范围不再位于 table.
中
下面的代码演示了原理。它使用一个 Range 对象,而不是 Selection,因为它更容易控制并且更 predictable。为了专注于逐个单元格地循环 table 的原理,它也非常简化,这可能有点令人难以置信。 (Debug.Print 只是为了在测试时保持跟踪。)
查找是否成功存储在布尔变量bFound
中。在成功的情况下,找到的范围被测试是否在 table 中。 (请注意,您也可以使用 rngFind.Information(wdWithinTable)。)如果是,则折叠范围,以便找到的术语是 "outside" 它,然后范围扩展到单元格的末尾。
在循环中重复查找,直到在该单元格中找不到更多 "hits"。然后将 Range 移动到下一个单元格并重复查找,直到找到的 Range 不再位于 table 中。然后 Find 返回到循环中的 "normal" 过程,直到找不到更多搜索词的实例。
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
作为关于 range.find
的 previous question 的替代方案,我正在尝试 Selection.find
。
我发现 table 中出现了一个缩写。我想从该结果的位置继续我的搜索。
但是,当我获得范围并 select 它时,选择从行的开头开始。
我怎样才能限制它来自上一次出现?
当前代码:
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
调试时,我在 myRange.Select
后看到以下值。在检查文档时。我看到该行开头的文本是 selected
myRange.Start : 18838
Selection.Start : 18216
使用(临时)书签记下您要重新启动的位置。 不要 尝试依赖 Start
和 End
属性。那些都不靠谱。
当 Find 可能在 table 中结束并且找到的术语将继续存在于该位置时,从该点开始搜索到文档的结尾(或开头)将自动包括整行.如果您在一个单元格中单击然后按住 Shift 键并按向右箭头直到选择超出 table.
,您可以以用户身份看到它在这种情况下,您需要测试找到的Range是否在table中。如果是,则需要逐个单元格地继续查找循环,直到找到的范围不再位于 table.
中下面的代码演示了原理。它使用一个 Range 对象,而不是 Selection,因为它更容易控制并且更 predictable。为了专注于逐个单元格地循环 table 的原理,它也非常简化,这可能有点令人难以置信。 (Debug.Print 只是为了在测试时保持跟踪。)
查找是否成功存储在布尔变量bFound
中。在成功的情况下,找到的范围被测试是否在 table 中。 (请注意,您也可以使用 rngFind.Information(wdWithinTable)。)如果是,则折叠范围,以便找到的术语是 "outside" 它,然后范围扩展到单元格的末尾。
在循环中重复查找,直到在该单元格中找不到更多 "hits"。然后将 Range 移动到下一个单元格并重复查找,直到找到的 Range 不再位于 table 中。然后 Find 返回到循环中的 "normal" 过程,直到找不到更多搜索词的实例。
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