如何加快 MS Word 文档中多个单词的 VBA 样式替换？ [复制]

Question

几天前我一直在尝试使用以下脚本的一些变体来更改单词的样式 阵列内。该文档有大约 1200 页和 8MB 大小，但对于 MS Word 来说似乎更重。

它下面的脚本似乎比使用 Selection.Find 更快，但 40 分钟后我需要停止宏，因为 仅执行了 64 次迭代（共 182 次）。

还有其他方法可以提高这个宏的执行速度吗？我什至尝试使用嵌套循环查找每个段落的所有单词，但效果最差。

宏在文档中查找数组的每个单词并 如果单词是粗体而不是斜体，则适用 StyleA 如果单词不是粗体且不是斜体，则应用 StyleB 如果单词是斜体，则应用 StyleC

感谢您的帮助。

Sub ChangeStyles()
    Dim i As Long
    Dim Arr(1 To 182)
    Dim rng As Word.Range

Application.ScreenUpdating = False

Arr=Array("Word1","Word2",..,"Word182",)

For i = 0 To UBound(Arr)
    Set rng = ActiveDocument.Content

    With rng.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = Arr(i)
        .Execute
        If rng.Characters(1).Font.Bold = True And rng.Characters(1).Font.Italic = False Then
        .Replacement.Style = ActiveDocument.Styles("StyleA")
        ElseIf rng.Characters(1).Font.Bold = False And rng.Characters(1).Font.Italic = False Then
            .Replacement.Style = ActiveDocument.Styles("StyleB")
        ElseIf rng.Characters(1).Font.Italic = True Then
            .Replacement.Style = ActiveDocument.Styles("StyleC")
        End If
        .Execute Replace:=wdReplaceAll
    End With
    Debug.Print "word: " & i
Next


Application.ScreenUpdating = True

End Sub

Answer 1

您的代码中的逻辑是错误的。尽管您设置了替换样式，但您没有设置任何格式供Find 查找。因此，.Execute Replace:=wdReplaceAll 将找到 .Text = Arr(i) 的所有实例，并将样式替换为第一个结果中 If 语句中设置的样式。

正如 Cindy Meister 在她的评论中指出的那样，对每个单词使用多次查找和替换迭代可能会产生最快的结果。

我已经编辑了您的代码，以向您展示如何实现这一目标。

Sub ChangeStyles()
  Dim i As Long
  Dim Arr(1 To 182)

  Application.ScreenUpdating = False

  Arr=Array("Word1","Word2",..,"Word182",)

  For i = 0 To UBound(Arr)
    ReplaceStyle SearchText:=Arr(i), Bold:=True, Italic:=False, NewStyle:=ActiveDocument.Styles("StyleA")
    ReplaceStyle SearchText:=Arr(i), Bold:=False, Italic:=False, NewStyle:=ActiveDocument.Styles("StyleB")
    ReplaceStyle SearchText:=Arr(i), Bold:=False, Italic:=True, NewStyle:=ActiveDocument.Styles("StyleC")
  Next

  Application.ScreenUpdating = True

End Sub

Sub ReplaceStyle(SearchText As String, Bold As Boolean, Italic As Boolean, NewStyle As style)
  Dim rng As Range
  Set rng = ActiveDocument.Content
  With rng.Find
    .ClearFormatting
    .Text = SearchText
    With .Font
      .Bold = Bold
      .Italic = Italic
    End With
    .Replacement.ClearFormatting
    .Replacement.style = NewStyle
    .Execute Replace:=wdReplaceAll
  End With
End Sub