Wie kann man einen VBA-Code beschleunigen?

Question

Ich fand diesen Code online, um mehrere Wörter zu suchen und hervorzuheben. Es dauert ungefähr 10 Minuten, um es auf einem 15-seitigen Dokument auszuführen. Ich habe mich gefragt, ob es schneller gemacht werden könnte.

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 

Answer 1

Die Kommentare sind hier richtig, Sie müssen nur den Fund laufen und einmal in der Liste pro Artikel ersetzen, die Sie ausführen es mehrmals durch die Menge der Wörter im Dokument.

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