不重复保留word文档中的字符

ttkxssry

413191246se 发表于 2018-4-15 14:06
楼主，如果文档较大，请耐心等待，不要动键盘、鼠标，请试用下面的宏：

非常非常感谢您的热心帮助！

反馈一下运行结果：
6百万字的文档，运行后：

kqbt

413191246se 发表于 2018-4-15 14:06
楼主，如果文档较大，请耐心等待，不要动键盘、鼠标，请试用下面的宏：

辛苦了！有空体验一下代码效果。

ttkxssry

10楼的好朋友的代码非常强大，更让人感动的是这份热心肠，对我帮助非常大。在这里衷心感谢这位朋友！

目前，我有2个文档，有一个文档是6百万字符，另一个是2千万字符，运行后会认为是大文档而出现错误提示。

我在想，我是否应该改变思维来解决这个问题，总之，目的是删除重复的字符，达到这样的效果：全部保留原文档的字符，但保留下来的字符又互相不同（不重复）。

ttkxssry

我想到了一个办法，来解决大文档的问题。

我先将文档字符数减少，然后再运行10楼的代码。

duquancai

ttkxssry 发表于 2018-4-16 09:48
非常非常感谢您的热心帮助！

反馈一下运行结果：

删除。。。。。

413191246se

杜先生 代码 前 5 行，必须放到“Option Explicit”语句下面才能执行，要执行 main 这个程序，几乎是瞬间完成，但结果是否正确，不可知。——杜先生 辛苦了！——也谢谢 楼主 夸我半天，其实我的小程序对付小文档还行，大的不行。

lsdongjh

试试：

1. Sub test()
   
2.     Dim lngCount As Long, lngIndex As Long
   
3.     Dim strTemp As String
   
4.     Dim strText As String, arrKeys As Variant, strResult As String
   
5.     Dim objDic As Object
   
6.    
   
7.     Set objDic = CreateObject("Scripting.Dictionary")
   
8.     lngCount = ThisDocument.Characters.Count
   
9.     strTemp = ThisDocument.Content
   
10.     For lngIndex = 1 To lngCount
    
11.         strText = Trim(Mid(strTemp, lngIndex, 1))
    
12.         If strTemp <> "" Then objDic(strText) = ""
    
13.     Next
    
14.    
    
15.     arrKeys = objDic.keys
    
16.    
    
17.     strResult = Join(arrKeys, "")
    
18.    
    
19.     ThisDocument.Content = strResult
    
20.     MsgBox "OK"
    
21. End Sub

复制代码

ttkxssry

lsdongjh 发表于 2018-4-17 10:14
试试：

有劳lsdongjh 大驾光临，非常感谢！

运行了一下，重复的字符还是存在。我现在网速太慢，测试的附件粘不上来。

lsdongjh

ttkxssry 发表于 2018-4-17 10:27
有劳lsdongjh 大驾光临，非常感谢！

运行了一下，重复的字符还是存在。我现在网速太慢，测试的附件粘 ...

前面发错地方了。

运行前，200多万字


运行后：3000多字

ttkxssry

lsdongjh 发表于 2018-4-17 11:27
前面发错地方了。

运行前，200多万字

不好意思，我是随手从诗词里复制了任意一段文字拷贝到新文档中进行测试的。该文档见附件。

其中，⊿，拍，等字符在运行完后，仍存在重复。