重复字符的查找统计并删除

weiyingde

原文档：
寻寻觅觅，冷冷清清，凄凄惨惨戚戚。乍暖还寒时候，最难将息。
目标文档：
寻2觅2冷清2凄2惨2戚2。乍暖还寒时候，最难将息。
要求：
将原文档整理成目标文档，若是字符重复则将重复次数写在重复的词语后，多余全部删除

kqbt

如果用正则表达式的话效率应该很高。供参考：

1. Sub DelReps()
   
2.     Dim wRng As Range, zRng As Range, n As Integer
   
3.     Set wRng = ThisDocument.Content
   
4.     With wRng.Find
   
5.         .ClearFormatting
   
6.         .Replacement.ClearFormatting
   
7.         Do While .Execute("([一-龥])\1", , , True)
   
8.             n = 1
   
9.             Set zRng = ThisDocument.Range(wRng.End, wRng.End + 1)
   
10.             Do While InStr(wRng, zRng)
    
11.                 n = n + 1
    
12.                 wRng.SetRange wRng.Start, zRng.End
    
13.                 zRng.SetRange wRng.End, wRng.End + 1
    
14.             Loop
    
15.             With wRng
    
16.                 .SetRange wRng.Start + 1, wRng.End
    
17.                 .Text = "[" & n + 1 & "]"
    
18.                 .SetRange wRng.End, ThisDocument.Content.End
    
19.             End With
    
20.         Loop
    
21.     End With
    
22. End Sub

复制代码

weiyingde

kqbt 发表于 2017-4-27 14:45
如果用正则表达式的话效率应该很高。供参考：

谢谢，却才发现，马上测试。