我在网上发现这个代码可以搜索并突出显示多个单词。在15页的文档上运行大约需要10分钟。我想知道是否可以更快地运行。
Sub HighlightMultipleWords()
Dim Word As Range
Dim WordCollection(2) As String
Dim Words As Variant
'Define list.
'If you add or delete, change value above in Dim statement.
WordCollection(0) = "word1"
WordCollection(1) = "word2"
WordCollection(2) = "word3"
'Set highlight color.
Options.DefaultHighlightColorIndex = wdYellow
'Clear existing formatting and settings in Find feature.
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
'Set highlight to replace setting.
Selection.Find.Replacement.Highlight = True
'Cycle through document and find words in collection.
'Highlight words when found.
For Each Word In ActiveDocument.Words
For Each Words In WordCollection
With Selection.Find
.Text = Words
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Next
Next
End Sub
答案 0 :(得分:2)
这里的评论都是正确的,您只需要在列表中的每个项目上运行查找和替换一次,您将按文档中的单词数量多次运行它。
Option Explicit
Sub HighlightMultipleWords()
Dim AryWords(2) As String
Dim VntStore As Variant
'Define list.
'If you add or delete, change value above in Dim statement.
AryWords(0) = "word1"
AryWords(1) = "word2"
AryWords(2) = "word3"
'Set highlight color.
Options.DefaultHighlightColorIndex = wdYellow
With Selection.Find
'Clear existing formatting and settings in Find feature.
.ClearFormatting
.Replacement.ClearFormatting
'Set highlight to replace setting.
Selection.Find.Replacement.Highlight = True
'Process the array
For Each VntStore In AryWords
.Execute FindText:=VntStore, _
MatchCase:=False, _
MatchWholeWord:=False, _
MatchWildcards:=False, _
MatchSoundsLike:=False, _
MatchAllWordForms:=False, _
Forward:=True, _
Wrap:=wdFindContinue, _
Format:=True, _
Replace:=wdReplaceAll
Next
End With
End Sub