VBA批量删除word中重复段落

年初学了一些VBA的基础知识，我觉得VBA应该是一个不错的解决方法，但是我现在对VBA的熟练程度还不足以从头到尾自己编写一段代码来处理。于是我想到的就是，如果是一个熟练掌握VBA技能的人，他会如何处理批量删除重复段落的问题？

我尝试用百度找了一下答案，效果不好，于是用英文重新表述一下问题，用谷歌搜索结果，再进行几次迭代，就找到了问题的答案。

找到了两个方案相关的代码，进行了测试，亲测可用。

我用两种段落进行测试

第一种段落是3行，该段落重复2次

第二种段落是1行，该段落重复3次

方案一：

Sub 删除重复段落方案一DeleteDuplicateParagraphs()Dim p1 As ParagraphDim p2 As ParagraphDim DupCount As LongDim StartTime As DoubleDim SecondsElapsed As Double
StartTime = Timer
For Each p1 In ActiveDocument.ParagraphsIf p1.Range.Text <> vbCr Then
For Each p2 In ActiveDocument.ParagraphsIf p1.Range.Text = p2.Range.Text ThenDupCount = DupCount + 1If p1.Range.Text = p2.Range.Text And DupCount > 1 Then p2.Range.DeleteEnd IfNext p2End IfDupCount = 0Next p1
SecondsElapsed = Round(Timer - StartTime, 2)
MsgBox 'This code ran successfully in ' & SecondsElapsed & ' seconds', vbInformationDupCount = 0
End Sub

                                        删除重复段落方案一

解释一下方案一的思路，使用内外嵌套循环对比段落的文本内容。比如第个嵌套循环是从第一段开始，假设整个文档有9段。这时，有两个变量，定义为段落类型，p1和P2，外层的p1的段落序号始终等于1，内层的p2段落序号从p(1)到p2(9)，如果出现内外层相等，对文本等于该段落的进行计数，如果内循环里的段落文本和外循环里的文本相等，且计数dupcount大于2，那么对当前循环的段落执行删除操作。

p1(1)循环结束，开始继续进行p1(2)循环，然后p2继续从p2(1)到p2(9)。

这个方案，设计思路上比较好理解，但是会随着段落数的增加，循环次数会呈现平方倍的增加，也就是代码执行效率会下降，这个可以通过里面的另外一个计时函数timer来进行对比。整个循环结束，会用消息框来提示代码的执行时间。

方案二：

Sub 删除重复段落方案二DeleteDuplicateParagraphs()Set d = CreateObject('Scripting.Dictionary')  Dim p As Paragraph  Dim t As Variant  Dim i As Integer  Dim StartTime As Single
  StartTime = Timer
' collect duplicates 收集重复项  For Each p In ActiveDocument.Paragraphs    t = p.Range.Text    If t <> vbCr Then      If Not d.Exists(t) Then d.Add t, CreateObject('Scripting.Dictionary')      d(t).Add d(t).Count + 1, p    End If  Next
  ' eliminate duplicates 删除重复项Application.ScreenUpdating = FalseFor Each t In dFor i = 2 To d(t).Count      d(t)(i).Range.DeleteNextNext  Application.ScreenUpdating = True
  MsgBox 'This code ran successfully in ' & Round(Timer - StartTime, 2) & ' seconds', vbInformationEnd Sub

                                              删除重复段落方案二

解释一下方案二的设计思路，

方案二用到了VBA里的词典技术，整个代码分为两个部分，第一个部分是收集重复项，也就是段落文本到一个词典里，第二个部分是删除重复项。

第一个部分相当于把所有的段落全部放到一个Excel表里，第二步是对该列里的单元格进行计数求和，如果出现某一个内容的单元格数量大于等于2，那么对于字典里的序号为2及序号大于2的重复段落使用for循环执行删除操作。

这里也用到的了循环函数，但是循环效率比方案一大大提高。这个可以从代码的执行时间上看得出来。当段落数量较少的时候差别不大，但是当段落数量较多的时候，差别会非常大。懂算法的小朋友可以在留言区计算一下两种算法的复杂度函数。

参考资料：

https:///questions/33562468/duplicate-removal-for-vba-word-not-working-effectively

学习心得

对于我这样一个VBA菜鸟，基础为0，原来是看不懂代码的，唯一的基础就是年前在51CTO上自学了一个曾贤志老师的Excel VBA课程。先能够读懂，运行好别人的代码，理解思路，知道各个函数的种类，对象种类，操作方法种类，然后在这个基础上根据自己的需求修改，才算是慢慢拥有制作牛刀的能力。原来都是去买刀，但是一定会有一些时候，你买到需要的刀，那就需要自己制作了，后面几个重要的整理聊天记录应用会在这两个方案的基础上进行迭代。

再有一个就是，学习技术，一定要善用英文搜索工具，命中率比中文搜索引擎高多了，中文搜索引擎被污染的太厉害了。