刪除 Microsoft Word 文檔中所有拼寫錯誤的單詞

Question

我有許多單詞拼寫錯誤的word文檔，希望批量刪除。 我已經嘗試了下面提到的兩種解決方案，但它們似乎對我來說都失敗了。

https://answers.microsoft.com/en-us/msoffice/forum/all/how-to-remove-all-misspelled-words-in-ms-word-at/608dbb5d-e719-4b5f-b44e-1b0542b66bd7

Sub DeleteSpellingErrors()
Dim rng As word.Range, i As Integer
If Selection.Range.Start = Selection.Range.End Then
    Set rng = ActiveDocument.Content
Else
    Set rng = Selection.Range
End If
If rng.SpellingErrors.Count > 0 Then
    For i = rng.SpellingErrors.Count To 1 Step -1
        rng.SpellingErrors(i).Delete
    Next
End If
End Sub

https://answers.microsoft.com/en-us/msoffice/forum/all/remove-all-misspelled-words-in-my-word-document/b686c318-c1fc-4d90-9e56-e922bb556abd

使用這些宏代碼會導致我的 microsoft word 無限期凍結（我使用的是第 10 代 intel i7）。 盡管已經等待了幾個小時，但仍然沒有任何進展。 在我看來，這些代碼只適用於較短的文檔，但因為我的 word 文檔有 200 多頁，所以它似乎凍結了。 有沒有人有任何其他代碼建議？ 更好的是，有沒有人有任何建議可以讓我在多個單詞文檔中批量刪除拼寫錯誤的單詞？ 目前，我一次刪除一個文檔中拼寫錯誤的單詞。 謝謝你的幫助！

Answer 1

您的代碼在我的 PC 上運行良好，文檔包含 350 個拼寫錯誤。

如果您有超過 200 頁的文檔，最好在宏運行時禁用屏幕更新。 我還將在 for 循環中添加一個“doevents”語句，以便至少 CTRL Break 將停止程序。 最初，您可能還想 debug.print 錯誤計數以查看宏的進展情況。

Option Explicit

Sub DeleteSpellingErrors()

    Dim rng As Word.Range
    Dim i As Long
    
    If Selection.Range.Start = Selection.Range.End Then
    
        Set rng = ActiveDocument.StoryRanges(wdMainTextStory)
        
    Else
    
        Set rng = Selection.Range
        
    End If
    
    If rng.SpellingErrors.Count > 0 Then
    
        Application.ScreenUpdating = False
        Debug.Print "Total errors = ", rng.SpellingErrors.Count ' for debugging only
        
        For i = rng.SpellingErrors.Count To 1 Step -1
    
            DoEvents
            rng.SpellingErrors.Item(i).Delete
        
            Debug.Print i, rng.SpellingErrors.Count ' for debug only.  Note Count doesn't change
            
        Next
        
        Application.ScreenUpdating = True
        Application.ScreenRefresh
        
    End If
    
End Sub

Answer 2

試試這個代碼片段是否更快一點：

    Sub DeleteSpellingErrors()
    Dim cnt As Long
    Dim cur As Range
    Dim doc As Document
    Set doc = ActiveDocument
    cnt = doc.Range.SpellingErrors.Count
    Set cur = doc.GoTo(What:=wdGoToSpellingError, Which:=wdGoToFirst)
    For i = 1 To cnt
        cur.Select
        cur.Delete
        Debug.Print cnt & " " & i
        Set cur = doc.GoTo(What:=wdGoToSpellingError, Which:=wdGoToNext)
        DoEvents
    Next
End Sub

很可能您將不得不重新運行該過程兩到三次，因為我看到 SpellingErrors.Count 不准確。

使用以下其他編碼可以避免重新運行：

Sub DeleteSpellingErrors()
    Dim cnt, i As Long
    Dim cur, Last As Range
    Dim doc As Document
    Set doc = ActiveDocument
    cnt = doc.Range.SpellingErrors.Count
    Set cur = doc.GoTo(What:=wdGoToSpellingError, Which:=wdGoToFirst)
    Set Last = doc.GoTo(What:=wdGoToSpellingError, Which:=wdGoToLast)
    i = 1
    Do While cur <> Last
        cur.Select
        cur.Delete
        Debug.Print cnt & " " & i
        Set cur = doc.GoTo(What:=wdGoToSpellingError, Which:=wdGoToNext)
        DoEvents
        i = i + 1
    Loop
End Sub

出於測試目的，該文檔由 107 頁組成，其中包含 3000 多個拼寫錯誤，並且執行需要幾分鍾（大約 3 或 4 分鍾）。