2篇word文档比较重复率_Word VBA删除大文档（长文档）重复标题段落

Word VBA删除大文档（长文档）重复标题段落

一、删除重复段落常用方法

有一些word文档存在许多重复的内容需要去除。人工查找这些重复的内容，不仅费时费力，而且很可能不能做到完全去重，所以要找到一些快速批量去除重复的办法。

在word中删除重复段落的方法，在网络上有很多，一般都是写正则表达式。具体做法如下：

（1）Ctrl+H调出查找和替换对话框，勾选“使用通配符”

查找内容：^13(?*^13)(*)1

替换：^p12

连续或非连续的重复段落均可去除，保留的是重复段落中第一个出现的段落。替换前将光标置于文档最开始的位置，需要点击“全部替换”多次，直到提示“0处替换”即可。

（2）Ctrl+H调出查找和替换对话框，勾选“使用通配符”

查找内容：^13(?*^13)1

替换：^p1

这可以去除连续的重复段落，保留的是重复段落中第一个出现的段落。替换前将光标置于文档最开始的位置，需要点击“全部替换”多次，直到提示“0处替换”即可。

如果确定文档的重复段落是连续的，那么可以使用方法（2）进行去除，运行速度会比较快；如果不确定，就用方法（1）。

以上方法对付小文档还是可以的，如果遇上百万字的大文档，就不太好用了。

二、大文档去除重复段落

一些大文档，大几百页，一百多万字。普通的办公电脑，使用上述方法进行去除，word程序将会长时间不响应，那个圈圈一直在转。况且要点击替换多次，时间就更长了。甚至程序直接崩溃。

前几天就碰到一个这样的文档，有868页，1171600字，直接用上述方法进行去除重复段落，几次尝试之后，都以无法忍受word长时间不响应而告终。

后来，观察文档，发现重复的段落都是以字符串“<目录>”开始的。这些段落其实就是文档中每篇文章的标题。如果把所有以“<目录>”开始的段落设置为标题1样式后，可以在导航窗格中看到这个文档的结构图，如下图所示。这样的标题一共有746个，分布在文档各处。

手工删除

如果手工删除，可以这样做。浏览左侧的导航窗格，把重复的标题段落中的第一个标题留下并设置为其他样式，其它不管。这样浏览完整个文档后，所以想要保留的标题都应该设置成了其他样式。如果不放心可以再检查一遍。

然后用查找替换的功能，把所有标题1样式的段落删除，这还是很容易做到的。查找替换对话框的设置如下图所示。在“查找内容”中不输入任何字符，只需要限定样式为“标题1”，在“替换为”中不输入任何字符。需要去除勾选“使用通配符”，然后点击“全部替换”，很快重复的标题就全部被删除了。

但是这样的方法最少也需要半天的时候，而也可能出现遗漏或误删。

使用vba删除重复标题

还可以使用vba编写代码的方式来快速完成。思路为：把所有以“<目录>”开头的段落设置为标题1样式；为标题1样式的段落加上编号，为使用listparagraphs对象做准备；使用两层嵌套循环，把标题1段落两两比较，把除了第一个标题以外的所有标题设置为斜体；最后删除所有斜体的标题1段落，从而达到删除重复标题段落的目的。代码如下：

Sub 删除大文档重复标题()
    Dim i As Long, j As Long
    Dim biaoti As Paragraph
    Dim StartTime As Single, EndTime As Single
    StartTime = Timer
    Application.ScreenUpdating = False
    '将所有以“<目录>”开头的段落设置为标题1样式
    Selection.find.ClearFormatting
    Selection.find.Replacement.ClearFormatting
    Selection.find.Replacement.Style = ActiveDocument.Styles("标题 1")
    With Selection.find
        .Text = "<目录>*^13"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchWildcards = True
    End With
    Selection.find.Execute Replace:=wdReplaceAll
 
    '为标题1加上自动编号，为使用listparagraphs做准备
    With ListGalleries(wdNumberGallery).ListTemplates(1).ListLevels(1)
        .NumberFormat = "%1"
        .TrailingCharacter = wdTrailingTab
        .NumberStyle = wdListNumberStyleArabic
        .NumberPosition = CentimetersToPoints(0)
        .Alignment = wdListLevelAlignLeft
        .TextPosition = CentimetersToPoints(0.74)
        .TabPosition = wdUndefined
        .ResetOnHigher = 0
        .StartAt = 1
        .LinkedStyle = "标题 1"
    End With
    ActiveDocument.Styles("标题 1").LinkToListTemplate ListTemplate:= _
        ListGalleries(wdNumberGallery).ListTemplates(1), ListLevelNumber:=1
 
    '每一个标题都和其他标题比较一次，如果两标题相同，把下一标题设置为斜体，以区别于要保留的唯一标题
    For i = 1 To ActiveDocument.ListParagraphs.Count
        If ActiveDocument.ListParagraphs(i).Range.Font.Italic = False Then '去除已经比较过的标题,提高程序效率
            Set biaoti = ActiveDocument.ListParagraphs(i)  '获取第一个标题，并赋值给biaoti
            '把下面的所有标题与biaoti比较，相同，则斜体。
            For j = (i + 1) To ActiveDocument.ListParagraphs.Count
                If biaoti.Range = ActiveDocument.ListParagraphs(j).Range Then
                    ActiveDocument.ListParagraphs(j).Range.Font.Italic = True
                End If
            Next
        End If
    Next
 
    '删除所有斜体的标题，即重复标题
    For Each biaoti In ActiveDocument.ListParagraphs
        If biaoti.Range.Font.Italic = True Then
            biaoti.Range.Delete
        End If
    Next
    Application.ScreenUpdating = True
    EndTime = Timer
    MsgBox "用时" & EndTime - StartTime '显示程序运行时间
End Sub

最后用时195秒，得到了100多个不重复的标题。

代码中前面两段都是通过录制宏的方式得到的，做了一些删减。后面的两层嵌套循环比较并标志重复段落的方法是可行，不过应该会有更好的办法，不知道有哪位大神赐教！

对于在大文档中删除重复段落，最有效率的办法，应该是先观察文档，找到重复段落的一些特征，再结合查找替换、vba代码等方式进行删除。