删除 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 分钟）。