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

chendeyan126

Word VBA删除大文档（长文档）重复标题段落
一、删除重复段落常用方法
有一些word文档存在许多重复的内容需要去除。人工查找这些重复的内容，不仅费时费力，而且很可能不能做到完全去重，所以要找到一些快速批量去除重复的办法。
在word中删除重复段落的方法，在网络上有很多，一般都是写正则表达式。具体做法如下：
（1）Ctrl+H调出查找和替换对话框，勾选“使用通配符”
查找内容：^13(?*^13)(*)\1
替换：^p\1\2
连续或非连续的重复段落均可去除，保留的是重复段落中第一个出现的段落。替换前将光标置于文档最开始的位置，需要点击“全部替换”多次，直到提示“0处替换”即可。
（2）Ctrl+H调出查找和替换对话框，勾选“使用通配符”
查找内容：^13(?*^13)\1
替换：^p\1
这可以去除连续的重复段落，保留的是重复段落中第一个出现的段落。替换前将光标置于文档最开始的位置，需要点击“全部替换”多次，直到提示“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代码等方式进行删除。

最后上传一下这个大文档，供有兴趣的人试试，看有没有其他好办法。
医学纲目.zip (1.51 MB, 下载次数: 12)

2019-1-24 14:53 上传

点击文件名下载附件

相见是缘8

感谢您的辛勤劳动！感谢分享！