Word删除重复行

gwjkkkkk

常扬帆 发表于 2024-1-15 13:35
您好！您的代码真的牛，上千页的文档处理速度很快，处理得也很干净。不过，我还有另一个请求，就是能不能 ...

Option Explicit
Sub test()
    Dim dic As Object, Par As Paragraph, n&, strKey$
   
    Application.ScreenUpdating = False
    Set dic = CreateObject("Scripting.Dictionary")
   
    With ActiveDocument
        .DeleteAllEditableRanges wdEditorEveryone
        For Each Par In .Paragraphs
            If Len(Par.Range.Text) <> 1 Then
                Par.Range.Select
                Selection.Collapse
                strKey = Par.Range.Text & Selection.Range.Font.Name
                If Not dic.Exists(strKey) Then
                    dic.Add strKey, vbNullString
                Else
                    Par.Range.Editors.Add wdEditorEveryone
                    n = n + 1
                End If
            End If
        Next
        .SelectAllEditableRanges wdEditorEveryone
        .DeleteAllEditableRanges wdEditorEveryone
    End With
   
    If n Then Selection.Delete

    Application.ScreenUpdating = True
End Sub

gwjkkkkk

请参考附件。。。

常扬帆

gwjkkkkk 发表于 2024-1-15 21:00
请参考附件。。。

衷心感谢您！好爽，我真的要怀疑人生了