Change style of some words is very slow VBA Word

问题

I´d like to change the style of several words in all instances within active document since each word could appear more than once within document. The words are stored in array Arr(). Some words are bold and some are unbold. If the wordX found is unbold a want to replace the style to StyleA and if it is bold I want to change it to StyleB

I have the following code so far that since to have 2 issues.

1-) Both, words with bold and not bold format are change to StyleA 2-) The execution time is very very slow. I tested the loop from 1 to 5 and it took almost a minute.

May someone help me to fix these 2 issues. Thanks in advance.

Sub ReplaceStyle()
Dim Arr(1 to 200)

Arr(1) = "Word1"
Arr(2) = "Word2"
.
.
.
Arr(200) = "Word200"

For i = 1 To Ubound(Arr)
    With Selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = Arr(i)
        .Replacement.Text = ""
        If Selection.Font.Bold = False Then
            .Replacement.Style = ActiveDocument.Styles("StyleA")
        Else
            .Replacement.Style = ActiveDocument.Styles("StyleB")
        End If

        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        .Execute Replace:=wdReplaceAll
    End With
Next

End Sub

回答1:

The logic of the code in the question is faulty. Find needs to have actually located the search term before code can test whether it's bold or not bold.

Two basic approaches would be possible

1. Search the term, when found perform the test and apply the style
2. Search each term twice, once for bold and once for not bold

You'd need to test, but based on experience I believe the second approach would be faster as it can use ReplaceAll.

The code below demonstrates the principle, based on the code in the question. Note that it uses a Range object, rather than Selection as this is generally more efficient.

Sub FindReplaceFormattingVariations()
    Dim rng As Word.Range
    Dim searchTerm As String
    Dim Arr(1 to 200)

    Arr(1) = "Word1"
    Arr(2) = "Word2"
    .
    .
    .
    Arr(200) = "Word200"

For i = 1 To Ubound(Arr) 
    searchTerm = Arr(i)
    Set rng = ActiveDocument.content
    With rng.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = searchTerm
        .Font.Bold = True
        .Replacement.Style = ActiveDocument.Styles("StyleA")
        .Execute Replace:=wdReplaceAll
    End With

    With rng.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = searchTerm
        .Font.Bold = False
        .Replacement.Style = ActiveDocument.Styles("StyleB")
        .Execute Replace:=wdReplaceAll
    End With
Next    
End Sub

来源：https://stackoverflow.com/questions/59640773/change-style-of-some-words-is-very-slow-vba-word