VBA 단어 코드를 더 빨리 실행하는 방법은 무엇입니까?

Question

이 코드를 온라인으로 검색하여 여러 단어를 강조 표시했습니다. 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 

Answer 1

주석은 만 찾기를 실행하고 목록에 항목 당 한 번씩 교체해야합니다, 여기에 모든 올바른지, 당신은 문서의 단어의 양에 의해 그것을 여러 번 실행하고 있습니다.

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