突出显示选定范围内的特定单词

Question

我正在尝试选择两个词之间的范围，在找到的范围内找到一个词，最后为该词着色。

在图像中，我想选择“观察”和“支持信息”之间的范围，然后搜索“管理”字样并将它们涂成红色。

使用我的代码，我可以突出显示第一次出现的单词。

Sub RevisedFindIt4()
    ' Purpose: highlight the text between (but not including)
    ' the words "Observation:" and "Supporting Information:" if they both appear.
    Dim rng1 As Range
    Dim rng2 As Range
    Dim rngFound As Range
    
    On Error Resume Next
    
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
    Set rng1 = ActiveDocument.Range
    If rng1.Find.Execute(FindText:="Observation:") Then
        Set rng2 = ActiveDocument.Range(rng1.End, ActiveDocument.Range.End)
        If rng2.Find.Execute(FindText:="Supporting Information:") Then
            Set rngFound = ActiveDocument.Range(rng1.End, rng2.Start)
            If rngFound.Find.Execute(FindText:="Management") Then
                rngFound.Select
                Selection.Range.HighlightColorIndex = wdRed
            End If
        End If
    End If
    Selection.HomeKey wdStory
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

Answer 1

使用 Find 突出显示文本的代码修改版本。

Sub RevisedFindIt4()
    ' Purpose: highlight the text between (but not including)
    ' the words "Observation:" and "Supporting Information:" if they both appear.
    Dim rng1 As Range
    Dim rng2 As Range
    Dim rngFound As Range
    Dim highlightIndex As Long
    

    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
    'capture current highlight color so that it can be reset later
    highlightIndex = Options.DefaultHighlightColorIndex
    Options.DefaultHighlightColorIndex = wdRed

    Set rng1 = ActiveDocument.Range
    If rng1.Find.Execute(FindText:="Observation:") Then
        Set rng2 = ActiveDocument.Range(rng1.End, ActiveDocument.Range.End)
        If rng2.Find.Execute(FindText:="Supporting Information:") Then
            Set rngFound = ActiveDocument.Range(rng1.End, rng2.Start)
            With rngFound.Find
                .Replacement.highlight = True
                .Execute Replace:=wdReplaceAll, Forward:=True, FindText:="Management", ReplaceWith:="", Format:=True
            End With
        End If
    End If

    Options.DefaultHighlightColorIndex = highlightIndex
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

Answer 2

Word 中的 Find 方法可能有点难以管理。您想要实现的目标必须通过循环内的两次搜索来完成。第一个搜索找到下一个“观察：”，第二个搜索找到以下“支持信息：”。然后，您使用第一次搜索的结尾和第二次搜索的开始来生成需要“wdRed”的范围

以下代码在我的电脑上运行良好

Option Explicit

Sub RevisedFindIt4()
' Purpose: highlight the text between (but not including)
' the words "Observation:" and "Supporting Information:" if they both appear.
'Application.DisplayAlerts = False
'Application.ScreenUpdating = False

    Dim myOuterRange As Word.Range
    Set myOuterRange = ActiveDocument.StoryRanges(wdMainTextStory)
    With myOuterRange
        
        Do
            With .Find
            
                .ClearFormatting
                .MatchWildcards = True
                .Text = "(Observation)([: ]{1,})(^13)"
                .Wrap = wdFindStop
                
                If Not .Execute Then Exit Do
                
            End With
                
            Dim mystart As Long
            mystart = .End
            
            .Collapse direction:=wdCollapseEnd
            .Move unit:=wdCharacter, Count:=1
            myOuterRange.End = ActiveDocument.StoryRanges(wdMainTextStory).End
            
            
            With .Find
            
                .ClearFormatting
                .MatchWildcards = True
                .Text = "^13Supporting Information"
                .Wrap = wdFindStop
                
                
                If Not .Execute Then Exit Do
                
            End With
            
            Dim myEnd As Long
            myEnd = .Start
            
            ActiveDocument.Range(mystart, myEnd).Font.ColorIndex = wdRed
            
            .Collapse direction:=wdCollapseEnd
            .Move unit:=wdCharacter, Count:=1
            myOuterRange.End = ActiveDocument.StoryRanges(wdMainTextStory).End
            
        Loop
        
    End With
    
        
'Application.ScreenUpdating = True
'Application.DisplayAlerts = True
End Sub

更新 这是我第一次写的代码。我将第二次误读帖子并将我的代码修改为第一次提供的代码归咎于饼干（cookie）短缺。

Sub RevisedFindIt4()
' Purpose: highlight the text between (but not including)
' the words "Observation:" and "Supporting Information:" if they both appear.
'Application.DisplayAlerts = False
'Application.ScreenUpdating = False

    Dim myOuterRange As Word.Range
    Set myOuterRange = ActiveDocument.StoryRanges(wdMainTextStory)
    With myOuterRange
        
        Do
            With .Find
            
                .ClearFormatting
                .MatchWildcards = True
                .Text = "(Observation:)(*)(Supporting Information:)"
                .Wrap = wdFindStop
                
                If Not .Execute Then Exit Do
                
            End With
            
            Dim myInnerRange As Word.Range
            Set myInnerRange = .Duplicate
            
            With myInnerRange
                
                With .Find
                
                    .Text = "Management"
                    .Replacement.Font.ColorIndex = wdRed
                    .Wrap = wdFindStop
                    .Execute Replace:=wdReplaceAll
                    
                    
                End With
                
            End With
            
            .Collapse Direction:=wdCollapseEnd
            .Move unit:=wdCharacter, Count:=1
            myOuterRange.End = ActiveDocument.StoryRanges(wdMainTextStory).End
            
        Loop
        
    End With
    
        
'Application.ScreenUpdating = True
'Application.DisplayAlerts = True
End Sub