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

lsdongjh

ttkxssry 发表于 2018-4-17 12:27
不好意思，我是随手从诗词里复制了任意一段文字拷贝到新文档中进行测试的。该文档见附件。

其中，⊿， ...

好像没有你说的问题啊

ttkxssry

lsdongjh 发表于 2018-4-17 12:40
好像没有你说的问题啊

好奇怪啊！

我这里运行后，纹丝不动。我的office是2013，系统是win10 64位。

您能把您包含VBA代码的word文档传过来吗？我运行一下。谢谢

lsdongjh

新建 Microsoft Word 文档.rar (19.65 KB, 下载次数: 4)

2018-4-17 14:18 上传

点击文件名下载附件

ttkxssry

lsdongjh 发表于 2018-4-17 14:18

满怀着激动的心情来反馈一下结果。

在您上传的文档中运行了一下，7百万的文档，最后余9千多字符，2千万字符的文档，最后余1万2千多字符。

运行时间也不长。

万分感谢您一直以来的帮助，非常感激！祝您事事顺心、如意！

413191246se

楼主，下面是本坛大神 杜先生/老师 的代码，请把前 5 行放到 Option Explict 下面，Sub 前面，然后执行 main 宏（杜先生 想删除，可没那么容易，我幸好保留着）：

1. Private Declare Function hash Lib "ntdll.dll" Alias "RtlComputeCrc32" (ByVal start As Long, ByVal data As Long, ByVal Size As Long) As Long
   
2. Private Hash_Table() As Long
   
3. Private Count_Table As Long
   
4. Private H As Long
   
5. Public Count As Long
   
6. Sub main()
   
7.     Dim mts As Object, mt As Object, reg As Object, keys$()
   
8.     Dim myStr As String, n As Long, nDoc As Document, rStr As String
   
9.     myStr = ActiveDocument.Content.Text
   
10.     Set reg = CreateObject("vbscript.regexp")
    
11.     reg.Global = True: reg.Pattern = "[^\sx0bx0cx0exa0x02\u3000]"
    
12.     Set mts = reg.Execute(myStr)
    
13.     Call Init(mts.Count): ReDim keys(1 To mts.Count)
    
14.     For Each mt In mts
    
15.         Call Add(mt.Value, keys)
    
16.     Next
    
17.     For n = 1 To Count
    
18.         rStr = rStr & keys(n)
    
19.     Next
    
20.     Set nDoc = Documents.Add
    
21.     nDoc.Content.Text = rStr
    
22. End Sub
    
23. Public Sub Init(bCount&)
    
24.     Count = 0
    
25.     Count_Table = bCount * 1.33
    
26.     ReDim Hash_Table(Count_Table - 1)
    
27. End Sub
    
28. Public Function Add(Key, keys) As Boolean
    
29.     Dim k&
    
30.     H = (hash(0, StrPtr(Key), LenB(Key)) And &H7FFFFFFF) Mod Count_Table
    
31.     Do
    
32.         If Hash_Table(H) = 0 Then
    
33.             Count = Count + 1
    
34.             Hash_Table(H) = Count
    
35.             keys(Hash_Table(H)) = Key
    
36.             Add = True
    
37.             Exit Function
    
38.         End If
    
39.         If StrComp(Key, keys(Hash_Table(H))) = 0 Then Exit Function
    
40.         k = k + 1
    
41.         H = (H + k * k) Mod Count_Table
    
42.     Loop
    
43. End Function

复制代码

duquancai

413191246se 发表于 2018-4-17 17:38
楼主，下面是本坛大神 杜先生/老师 的代码，请把前 5 行放到 Option Explict 下面，Sub 前面，然后执行 mai ...

第11行 有个坑！呵呵。

413191246se

杜先生，我看不出来坑在哪里，在我的 2003 中运行良好，但代码看不懂。刚才看过新的 .Start = .End 就不知道是啥意思。