修改Word高亮宏：仅扫描选中文本以提升大文档处理效率

原宏的问题是循环中重复拆分词汇列表会额外消耗资源，且未严格限定搜索范围边界。下面是修改后的版本，既能只处理选中的文本，还优化了处理速度：

Sub B2_Highlighter_OnlySelectedText()
    Application.ScreenUpdating = False
    Options.DefaultHighlightColorIndex = wdBrightGreen
    
    ' 判断是否有选中内容
    If Selection.Type = wdSelectionIP Then
        MsgBox "请先选中需要处理的文本！", vbExclamation
        Application.ScreenUpdating = True
        Exit Sub
    End If
    
    Dim FRDoc As Document, FRListArr() As String, i As Long
    Dim targetRange As Range
    
    ' 读取外部词汇文档并一次性拆分成数组（提升效率）
    Set FRDoc = Documents.Open("C:\Users\Milan van Bree\Google Drive\Heerbeeck College\3. Extra materiaal algemeen\Macros for Word\B2words.docx", ReadOnly:=True, Addtorecentfiles:=False, Visible:=False)
    FRListArr = Split(FRDoc.Range.Text, vbCr)
    FRDoc.Close False
    Set FRDoc = Nothing
    
    ' 锁定选中区域作为处理范围
    Set targetRange = Selection.Range
    
    With targetRange.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .MatchWholeWord = True
        .MatchCase = False
        .Replacement.Text = "^&"
        .Replacement.Highlight = True
        .Forward = True
        .Wrap = wdFindStop ' 关键：搜索到选中区域末尾即停止，不涉及文档其他部分
        
        ' 遍历词汇数组，跳过空行
        For i = LBound(FRListArr) To UBound(FRListArr)
            If Trim(FRListArr(i)) <> "" Then
                .Text = Trim(FRListArr(i))
                .Execute Replace:=wdReplaceAll
            End If
        Next
    End With
    
    Set targetRange = Nothing
    Application.ScreenUpdating = True
End Sub

关键修改说明： #

• 新增选中内容判断：未选文本时直接弹出提示，避免无效执行
• 词汇列表一次性拆分：原宏每次循环都重复拆分文档内容，现在仅拆分一次存入数组，减少冗余操作
• 锁定搜索边界：设置.Wrap = wdFindStop，确保搜索严格限制在选中区域内
• 过滤空词汇：跳过外部文档中的空白行，避免无意义的搜索

内容的提问来源于stack exchange，提问作者Milan van Bree