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

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

使用“查找”突出显示文本的代码的修改版本。

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