如何使VBA字代码运行得更快?

时间:2016-06-10 12:39:04

标签: vba ms-word word-vba

我在网上发现这个代码可以搜索并突出显示多个单词。在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

1 个答案:

答案 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