如何改善慢宏？

Question

我需要使用 Word 宏來自動校對文檔。 我有一個 excel 文件，填寫了所有錯誤的拼寫單詞，在我將宏安裝到 Microsoft Word 后，只需要幾分鍾就完成了 Word 文檔的 1 頁的拼寫檢查。

我可以使用 .txt 替換 excel 以使其更快嗎？ 或者我應該改進什么？ 請在下面找到宏的代碼：

屬性 VB_Name = "PR"

Option Explicit 

Sub PR() 
    Dim Path As String
    Dim objExcel As Object 
    Dim iCount As Integer 
    Dim VChar As String 
    Dim OChar As String  

    Options.AutoFormatAsYouTypeReplaceQuotes = True     

    Path = "D:\Macro\rplPR.xlsx" 

    'Highlight variant characters 
    With ActiveDocument 
        .TrackRevisions = False 
        .ShowRevisions = False 
    End With       

    Set objExcel = CreateObject("Excel.Application") 
    objExcel.Workbooks.Open Path      

    For iCount = 2 To 2500 

        Selection.HomeKey Unit:=wdStory 
        VChar = objExcel.ActiveWorkbook.Sheets(1).Cells(iCount, 1)                                 

        If Len(VChar) = 0 Then Exit For           

        Selection.HomeKey Unit:=wdStory, Extend:=wdMove          

        With Selection.Find 
            .ClearFormatting 
            .Replacement.ClearFormatting 
            .Replacement.Highlight = True 
            .Text = VChar 
            .Replacement.Text = "^&" 
            .Execute Replace:=wdReplaceAll 
        End With             
    Next             

    objExcel.ActiveWorkbook.Close 
    objExcel.Quit      

End Sub 

Answer 1

將這些行向上移動到For語句的上方。 您正在設置它們 2,499 次，而您只需要設置一次。

        .ClearFormatting 
        .Replacement.ClearFormatting 
        .Replacement.Highlight = True 
        .Text = VChar 
        .Replacement.Text = "^&" 

所以每個點都是一個 function 調用。 有 5 次不必要的調用 2498 次，即 12,490 次 function 調用。

Function 調用雖然必不可少，但與其他操作相比速度很慢，因為有很多設置。

如果您不with ，那么額外的 12,490 個 function 調用以及總共 24,980 個慢速不必要的 function 調用。

Answer 2

試試下面的。 請注意，啟動 Excel（如果尚未運行）以及處理工作簿必然會產生一些開銷。 因此，即使是單頁文檔也會遇到與 100 頁文檔相同的開銷。

Sub BulkFindReplace()
Application.ScreenUpdating = False
Dim xlApp As Object, xlWkBk As Object, StrWkBkNm As String, StrWkSht As String
Dim iDataRow As Long, xlFList As String, xlRList As String, i As Long
StrWkBkNm = "D:\Macro\rplPR.xlsx": StrWkSht = "Sheet1"
'Start Excel
Set xlApp = CreateObject("Excel.Application")
If xlApp Is Nothing Then
  MsgBox "Can't start Excel.", vbExclamation
  Exit Sub
End If
On Error GoTo 0
With xlApp
  'Hide our Excel session
  .Visible = False
  ' The file is available, so open it.
  Set xlWkBk = .Workbooks.Open(StrWkBkNm, False, True)
  If xlWkBk Is Nothing Then
    MsgBox "Cannot open:" & vbCr & StrWkBkNm, vbExclamation
    .Quit: Set xlApp = Nothing: Exit Sub
  End If
  ' Process the workbook.
  With xlWkBk
    With .Worksheets(StrWkSht)
      ' Find the last-used row in column A.
      iDataRow = .Cells(.Rows.Count, 1).End(-4162).Row ' -4162 = xlUp
      ' Capture the F/R data.
      For i = 1 To iDataRow
        ' Skip over empty fields to preserve the underlying cell contents.
        If Trim(.Range("A" & i)) <> vbNullString Then
          xlFList = xlFList & "|" & Trim(.Range("A" & i))
          xlRList = xlRList & "|" & Trim(.Range("B" & i))
        End If
      Next
    End With
  .Close False
  End With
  .Quit
End With
' Release Excel object memory
Set xlWkBk = Nothing: Set xlApp = Nothing
'Exit if there are no data
If xlFList = "" Then Exit Sub
'Process each word from the F/R List
With ActiveDocument.Range.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .MatchWholeWord = True
  .MatchCase = False
  .Wrap = wdFindContinue
  For i = 1 To UBound(Split(xlFList, "|"))
    .Text = Split(xlFList, "|")(i)
    .Replacement.Text = Split(xlRList, "|")(i)
    .Execute Replace:=wdReplaceAll
  Next
End With
Application.ScreenUpdating = True
End Sub