根据单词是否粗体更改单词样式的速度很慢

我想更改活动文档中几个单词的样式。

• 每个单词可能出现多次。
• 有些词是粗体，有些是非粗体。

单词存储在数组中Arr().

如果找到的单词 X 是非粗体，则将样式替换为StyleA如果它是粗体，则将其更改为StyleB.

以下代码有两个问题。

1) 粗体和非粗体的单词格式改为StyleA.
2）执行时间慢。我测试了从1到5的循环，花了将近一分钟。

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

问题中的代码逻辑有问题。Find实际上需要有located代码前的搜索词可以测试它是否为粗体。

可能有两种基本方法

1. 搜索术语，找到后执行测试并应用样式
2. 每个术语搜索两次，一次为粗体，一次为非粗体

您需要进行测试，但根据经验，我相信第二种方法会更快，因为它可以使用ReplaceAll.

下面的代码根据问题中的代码演示了原理。请注意，它使用Range对象，而不是Selection因为这通常更有效。

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