删除不同章节下的重复段落

chenwenming · 发表于 2017-10-27 15:08

本帖最后由 chenwenming 于 2017-11-5 09:53 编辑

对不同段落标题下的重复段落删除（文中标黄色的)--附件1,数组集合方式是不是快些?还有什么好方法？
如果再提高一个难度，一二三级标题中都有重复项时---见附件2，又该如何删除呢？其实带点合并段落的意思，但不完全是。附件2的程序操作思路：在一级标题中，也就是以大写一、二等开头的，如“二、工作”就有两行，重了，删除第二个重的，删除后，发现在二级标题中（以小写数字开头的），又有重的，如“二、工作”大段落下有“3、后天”有两个重的，删除后面一个；删除后再看，第三级标题下，还有重的，如在“一、学习”(一级)段落“1、早上”（二级）段落下有“A、语文”有两个重的（表格不算），删除除后面一个，同理在“2、中午”下也有两个“B、数学”，同样删除后面下一个。同理“二、工作”大段落下也执行相似操作。（这儿判断标题级别是按开头字符来的，如果能直接判断标题级别就更高级了）

duquancai · 发表于 2017-10-27 15:27

没啥挑战性。。。。

chenwenming · 发表于 2017-10-27 15:53

本帖最后由 chenwenming 于 2017-10-27 16:56 编辑

duquancai 发表于 2017-10-27 15:27
没啥挑战性。。。。

好吧，我没想到

活在理想的世界 · 发表于 2017-10-27 16:20

没有什么更好的方法了，楼主的方法是世界上最好的方法，楼主威武。

duquancai · 发表于 2017-10-27 16:34

chenwenming 发表于 2017-10-27 15:53
吹吧，你到试试，看谁的速度快

本打主意写一个代码，经你这么回复，我不敢献丑了！

chenwenming · 发表于 2017-10-27 16:57

活在理想的世界发表于 2017-10-27 16:20
没有什么更好的方法了，楼主的方法是世界上最好的方法，楼主威武。

我说错了，我改正

chenwenming · 发表于 2017-10-27 16:58

duquancai 发表于 2017-10-27 16:34
本打主意写一个代码，经你这么回复，我不敢献丑了！

好吧，我说错了，我改正，不是心急嘛，说得不好，请原谅！

duquancai · 发表于 2017-10-27 20:09

本帖最后由 duquancai 于 2017-10-27 20:18 编辑

chenwenming 发表于 2017-10-27 16:58
好吧，我说错了，我改正，不是心急嘛，说得不好，请原谅！

Sub 你测试一下速度()
Dim mts As Object, reg As Object, n&, m&, Str$, doc As Document
Dim mhs As Object, x&, y&, p As Range, r As Range
Set doc = ActiveDocument
Set reg = CreateObject("vbscript.regexp")
reg.Global = True: reg.MultiLine = True
reg.Pattern = "^\s*\d+、(?:(?!^\s*\d+、).)+"
Set mts = reg.Execute(doc.Content.Text)
If Not mts Is Nothing Then
      For j = mts.Count - 1 To 0 Step -1
         m = mts(j).FirstIndex: n = mts(j).Length
         Set p = doc.Range(m, m + n)
         reg.Pattern = "^(.*)\r(?=.*^\1$)"
         Set mhs = reg.Execute(p.Text)
         If Not mhs Is Nothing Then
            For i = mhs.Count - 1 To 0 Step -1
                  x = mhs(i).FirstIndex: y = mhs(i).Length
                  Set r = doc.Range(p.Start + x, p.Start + x + y)
                  r.Text = Empty
            Next
         End If
      Next
End If
End Sub

chenwenming · 发表于 2017-10-27 21:35

duquancai 发表于 2017-10-27 20:09
Sub 你测试一下速度()
Dim mts As Object, reg As Object, n&, m&, Str$, doc As Document
Dim ...

谢谢！测试了一下，速度是快的，但没有实现删除的黄色重复行，而是删除的重复第一行

duquancai · 发表于 2017-10-27 21:50

本帖最后由 duquancai 于 2017-10-27 21:53 编辑

chenwenming 发表于 2017-10-27 21:35
谢谢！测试了一下，速度是快的，但没有实现删除的黄色重复行，而是删除的重复第一行

晕，删除重复段落既然是重复的，保留唯一的一段就行，非要删除黄色那一段才叫删除重复段落吗？你好好看看代码吧！如果看不懂请你再去修炼吧！！！

		自动登录	找回密码
密码			免费注册

[原创] 删除不同章节下的重复段落