删除 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 代英特尔 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

很可能您需要 re-run 两次或三次该过程，因为我发现 SpellingErrors.Count 不准确。

这个 re-run 可以用其他编码来避免：

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

这是另一个版本，只需要一个运行删除所有拼写错误，对于 Graham Mayor 的 add-in:

Function DeleteSpellingErrors(doc As Document) As Boolean
    Dim cnt, i As Long
    Dim cur, Last As Range
    If doc Is Nothing Then
        Set doc = Application.ActiveDocument
    End If
    Do
        cnt = doc.Range.SpellingErrors.Count
        If cnt <= 0 Then Exit Do
        Set Last = doc.GoTo(What:=wdGoToSpellingError, Which:=wdGoToLast)
        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
            i = i + 1
        Next
    Loop
    DeleteSpellingErrors = True
End Function

删除 Microsoft Word 文档中所有拼写错误的单词

Delete all misspelled words in Microsoft Word document

vba

ms-word

spelling