突出显示另一个 Word 或 Excel 文档中短语列表中的短语

Question

我在这个链接中找到了宏，它很好用，https://wordribbon.tips.net/T001173_Highlight_Words_from_a_Word_List.html：

它突出显示当前文档中另一个 Word 文档中的单词。我需要看看它是否适用于短语而不仅仅是单个单词。如果我需要在阶段前后放置识别标记，例如双括号或[[ ... ]]，那也没关系。这可能吗？如何将它放在这个宏中？

如果列表可以来自 Excel 文档，那就更好了，但不会破坏交易。

示例如下： 老虎托尼（但只有当宏找到整个短语时。因为它现在工作，它会独立找到所有三个单词的所有实例，“the”当然会有问题。另一个是“17th c”。在这种情况下，它也会找到每个 c 和每个点。最好只找到整个短语。

Answer 1

您发布的链接中的代码效率非常低。有关更有效的方法，请参阅：

https://www.msofficeforums.com/word-vba/23196-need-help-creating-macro.html

不需要其他文件的简单解决方案是：

Sub BulkHighlighter()
Application.ScreenUpdating = False
Dim i As Long, StrFnd As String, HiLt As Long
HiLt = Options.DefaultHighlightColorIndex
Options.DefaultHighlightColorIndex = wdBrightGreen
StrFnd = InputBox("Insert your 'Find' terms with | delimiters, for example:" & vbCr & "the quick brown fox|jumped over|the lazy dog")
With ActiveDocument.Range.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .MatchWholeWord = True
  .MatchCase = False
  .Replacement.Highlight = True
  .Replacement.Text = "^&"
  For i = 0 To UBound(Split(StrFnd, "|"))
    .Text = Split(StrFnd, "|")(i)
    .Execute Replace:=wdReplaceAll
  Next
End With
Options.DefaultHighlightColorIndex = HiLt
Application.ScreenUpdating = True
End Sub

或者，如果要突出显示的字符串列表是固定的：

Sub BulkHighlighter() Application.ScreenUpdating = False Dim i As Long, StrFnd As String, HiLt As Long HiLt = Options.DefaultHighlightColorIndex Options.DefaultHighlightColorIndex = wdBrightGreen StrFnd = "敏捷的棕狐|跳过|懒狗" 使用 ActiveDocument.Range.Find .ClearFormatting .Replacement.ClearFormatting .MatchWholeWord = True .MatchCase = 假 .Replacement.Highlight = True .Replacement.Text = "^&" For i = 0 To UBound(Split(StrFnd, "|")) .Text = Split(StrFnd, "|")(i) .执行替换：=wdReplaceAll 下一个 结束于 Options.DefaultHighlightColorIndex = HiLt Application.ScreenUpdating = True 结束子

如果您热衷于使用 Excel 文件，请尝试：

Sub BulkHighlighter()
Application.ScreenUpdating = False
Dim xlApp As Object, xlWkBk As Object, StrWkBkNm As String
Dim StrWkSht As String, xlFList As String, i As Long

'Identify the WorkBook and WorkSheet
StrWkBkNm = "C:\Users\" & Environ("Username") & "\Documents\BulkFindReplace.xlsx"
StrWkSht = "Sheet1"

On Error Resume Next
'Start Excel
Set xlApp = CreateObject("Excel.Application")
If xlApp Is Nothing Then
  MsgBox "Can't start Excel.", vbExclamation
  Exit Sub
End If
On Error GoTo 0
With xlApp
  'Hide our Excel session
  .Visible = False
  ' The file is available, so open it.
  Set xlWkBk = .Workbooks.Open(StrWkBkNm, False, True)
  If xlWkBk Is Nothing Then
    MsgBox "Cannot open:" & vbCr & StrWkBkNm, vbExclamation
    .Quit: Set xlApp = Nothing: Exit Sub
  End If
  ' Process the workbook.
  With xlWkBk
    With .Worksheets(StrWkSht)
      ' Capture the F/R data.
      For i = 1 To .Cells(.Rows.Count, 1).End(-4162).Row ' -4162 = xlUp
        ' Skip over empty fields to preserve the underlying cell contents.
        If Trim(.Range("A" & i)) <> vbNullString Then
          xlFList = xlFList & "|" & Trim(.Range("A" & i))
        End If
      Next
    End With
  .Close False
  End With
  .Quit
End With
' Release Excel object memory
Set xlWkBk = Nothing: Set xlApp = Nothing
'Exit if there are no data
If xlFList = "" Then Exit Sub
'Process each word from the F/R List
With ActiveDocument.Range.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .MatchWholeWord = True
  .MatchCase = True
  .Wrap = wdFindContinue
  .Replacement.Text = "^&"
  For i = 1 To UBound(Split(xlFList, "|"))
    .Text = Split(xlFList, "|")(i)
    .Execute Replace:=wdReplaceAll
  Next
End With
Application.ScreenUpdating = True
End Sub

有关使用 Excel 工作簿处理同一文件夹中的多个文档，请参阅：

https://www.msofficeforums.com/70404-post4.html

请注意，最后一个链接中的代码还显示了如何处理页眉、页脚等中的内容。