如何更高效删除Word文档重复词汇 现有VBA方案处理长文档过慢求优化

现状说明 #

当前采用逐词比对删除重复词汇的方案，1-4页文档处理耗时最高可达5分钟，无法满足50/100页大文档的低耗时处理需求，需优化现有逻辑或替换实现思路。

原有VBA实现代码 #

Sub Delete_Duplicates()
    '***********'
    'By
    'MBA
    '***********'
    Dim AD As Range
    Dim F As Range
    Dim i As Long
    
    Set AD = ActiveDocument.Range
    Z = AD.Words.Count
    y = 1
    For i = Z To 1 Step -1
        y = y + 1
        
        Set F = AD.Words(i)
        
        On Error Resume Next
        Set s = AD.Words(i - 1)
        If Trim(AD.Words(i - 1)) = "," Then Set s = AD.Words(i - 2): Set c = AD.Words(i - 1)
        If Err.Number > 0 Then Exit Sub
            
        If Not F.Text = Chr(13) And UCase(Trim(F.Text)) = UCase(Trim(s.Text)) Then
            F.Text = ""
            If Not c Is Nothing Then c.Text = " ": Set c = Nothing
        End If
        If Not c Is Nothing Then Set c = Nothing
    
        On Error Resume Next
        Call ProgressBar.Progress(y / Z * 100, True) '<<-- Progress Bar
        On Error GoTo 0
    
    Next
    Beep
End Sub

核心优化思路 #

• 禁用不必要的UI刷新：处理前添加Application.ScreenUpdating = False，处理完成后恢复为True，同时注释掉循环内的进度条调用代码，单次循环的UI开销可降低90%以上，是最立竿见影的优化手段。
• 改逐次操作文档为数组批量处理：先将全文词汇读取到VBA数组中，在数组内完成全部去重比对逻辑，最终一次性将处理后的内容回写文档，避免频繁调用Word COM对象带来的性能损耗，大文档场景下处理速度可提升数十倍。
• 增加无效字符提前过滤逻辑：提前跳过空格、换行符、标点等非词汇内容，减少有效比对次数。

处理前后效果对比 #

内容的提问来源于stack exchange，提问作者VBAbyMBA