Word文档内部检索重复内容的VBA程序代码及使用说明.docx
《Word文档内部检索重复内容的VBA程序代码及使用说明.docx》由会员分享，可在线阅读，更多相关《Word文档内部检索重复内容的VBA程序代码及使用说明.docx（14页珍藏版）》请在冰豆网上搜索。
Word文档内部检索重复内容的VBA程序代码及使用说明
引言：
现在信息量极大丰富，计算机的使用带来了很多的方便。
但同时，在整理各种资料、撰写综述性文章、申请书、毕业论文等等情况下，特别是涉及到长文档的时候，往往会出现内容的重复出现。
通常，这种重复是允许出现的，但是从文档质量来说，重复的内容在不同位置出现时，最好能够做一个变通——类似的意思，换一种说法，人们读起来会流畅的多。
可是很多人的习惯上是大量使用了Copy和Paste，会使读者感觉不太舒服，如果是评审人看到的话，往往就会行使其手中的权力——Pass了
另外一个困扰就是参考文献的重复出现问题。
虽然使用EndNote等类似的文献管理软件非常方便，也可以解决这个问题。
但我想大部分用户可能不太会用，或者不习惯使用，这从我身边的同事、同学、学生可以知道。
因此，找到一些简单的手段解决这些问题非常重要。
我从网上到处去找这样的小程序，发现了利用Word宏功能实现的两段内容，挺不错的。
经过实验能够使用，现在演示一下，并加以详细的解释说明，方便更多的人使用。
说明：
使用者要能够熟练使用word，稍微懂一点VisualBasic语言，当然完全不懂也没有太大关系，只要按照下面做就可以，只是如果懂一点的话，更容易看懂代码，并且可以进行一些改造，使其更适合个人使用。
我用来验证的系统为Win7旗舰版和Word2003。
操作演示：
启动Word2003，如果宏安全性高的话，无法使用宏功能，要进行设置“工具”——“宏”——“安全性”——“中”或“低”，再重新启动Word2003即可。
进入“工具”——“宏”——“VisualBasic编辑器”（或者使用快捷键Alt+F11直接进入），出现这个界面：
在Normal处，右键，菜单中，增加模块，将如下实例的代码直接复制到右边的代码区即可。
当然在Project里面如此操作也可以，但是只能对你要处理的文档有效，而在Normal中则保存为通用的功能了。
保存，退出VisualBasic，回到原来的文档状态。
运行刚刚加入的宏（可用Alt+F8直接启动）即可对当前活动的文档进行检查处理。
但是如果经常使用这个功能，操作会显得有点麻烦，应在工具栏中设立一个快捷菜单。
设置方法为：
“工具”——“自定义”弹出如下界面，“命令”——“宏”，将对应的功能直接拖入到工具栏中。
但拖入之后再工具栏中显示的名称是模块的名称（例如：
Normal.模块1.SearchSames）。
这样还不够直观，可以更名，如下操作：
“重排命令”——“工具栏”——“格式”——“更改所选内容”——“命名”。
实例（查找是否存在相同的句子）：
下面这段代码是可以按照句子的模式搜索文档内部全部内容的——根据标点符号来判断句子，按照一个句子检索全文中是否出现相同的句子，并且标记为红色。
SubSearchSames（）
DimiAsParagraph,oSenAsRange,MySearchRangeAsRange
DimMyArray（）AsString,aArrayAsVariant
OnErrorResumeNext'忽略错误
WithActiveDocument'遍历段落（注：
原始文献资料中提供的是ThisDocument，我发现没有反应，后来改为ActiveDocument可以了）
ForEachiIn.Paragraphs'如果为空白段落则跳过或者到达最后一个段落则进入下一个循环
IfVBA.Len（i.Range）=1Ori.Range.Start=.Content.Paragraphs.Last.Range.StartThenGoToGN
SetMySearchRange=.Range（i.Range.End,.Content.End）
WithMySearchRange.Find'在指定的RANGE中查找
MyArray=VBA.Split（i.Range,"，"）'由逗号为分隔符（本来在句子中循环，看了楼主的例子，修改）
.ClearFormatting'清除查找格式
ForEachaArrayInMyArray'在"句子"中循环,如果查找到该内容,则设置为红色
DoWhile.Execute（findtext:
=aArray）
MySearchRange.Paragraphs
（1）.Range.Font.Color=wdColorRed
Loop
Next
EndWith
GN:
Next
EndWith
EndSub
实例（查找是否存在相同的字符串）
网友的原始代码如下：
SubFindRepeat2003（）
DimsAsString,s1AsString,iAsLong,nAsLong
s=ActiveDocument.Content
n=3'所搜索重复字符串长度
Options.DefaultHighlightColorIndex=wdRed'将用红色标出
Fori=1ToLen（s）-2*n
s1=Mid（s,i,n）
IfInStr（i+Len（s1）,s,s1）>0Then
WithActiveDocument.Content.Find
.Text=s1
.Replacement.Text=s1
.Replacement.Highlight=True
.ExecuteReplace:
=wdReplaceAll
EndWith
ExitFor
EndIf
Next
EndSub
但是这个代码中，设定了n=3，当然用户可以自行更改为任意值，可是每次这样繁琐的操作，去修改代码再运行，会让用户崩溃的。
因此，我设置了一个小循环，一次性搜索字符串长度在150到250之间（Form=250to150）的所有内容，每次改变一个单位长度（Step-1）。
当然使用者，可以根据自己的情况，任意改变这几个参数。
SubFindRepeat2003（）
DimsAsString,s1AsString,iAsLong,nAsLong,mAsInteger,kAsInteger,lAsInteger
s=ActiveDocument.Content
Form=250To150Step-1
n=m'所搜索重复字符串长度
Options.DefaultHighlightColorIndex=wdBrightGreen'将用绿色标出（其他颜色也可以任意设置，只要将wdBrightGreen改成wdBlack黑色，wdRed红色，等等，详见后面的对应表）
Fori=1ToLen（s）-2*n
s1=Mid（s,i,n）
IfInStr（i+Len（s1）,s,s1）>0Then
WithActiveDocument.Content.Find
.Text=s1
.Replacement.Text=s1
.Replacement.Highlight=True
.ExecuteReplace:
=wdReplaceAll
EndWith
ExitFor
EndIf
Next
Nextm
EndSub
实例（清除颜色）
在上述操作后，删除了相同的内容，但是保留的内容的颜色会为后续操作带来一些不便，可以用下面的小代码，一次性清楚全部文档内容的颜色标记。
（当然，如果原来自己标注颜色的内容也会被清除）
SubClearColor2003（）'清除上面代码所标的红色:
ActiveDocument.Content.HighlightColorIndex=0
EndSub
附录（颜色代码）
索引号
颜色
16进制代码
R
G
B
1
黑色
Black
#000000
0
0
0
2
白色
White
#FFFFFF
255
255
255
3
红色
Red
#FF0000
255
0
0
4
鲜绿色
BrightGreen
#00FF00
0
255
0
5
蓝色
Blue
#0000FF
0
0
255
6
黄色
Yellow
#FFFF00
255
255
0
7
粉红色
Pink
#FF00FF
255
0
255
8
青绿色
Turquoise
#00FFFF
0
255
255
9
深红色
DarkRed
#800000
128
0
0
10
绿色
Green
#008000
0
128
0
11
深蓝色
DarkBlue
#000080
0
0
128
12
深黄色
DarkYellow
#808000
128
128
0
13
紫罗兰
Violet
#800080
128
0
128
14
青色
Teal
#008080
0
128
128
15
灰－25％
Gray-25%
#C0C0C0
192
192
192
16
灰－50％
Gray-50%
#808080
128
128
128
17
海螺色
Periwinkle
#9999FF
153
153
255
18
梅红色
Plum+
#993366
153
51
102
19
象牙色
Ivory
#FFFFCC
255
255
204
20
浅青绿
LiteTurquoise
#CCFFFF
204
255
255
21
深紫色
DarkPurple
#660066
102
0
102
22
珊瑚红
Coral
#FF8080
255
128
128
23
海蓝色
OceanBlue
#0066CC
0
102
204
24
冰蓝
IceBlue
#CCCCFF
204
204
255
25
深蓝色
DarkBlue+
#000080
0
0
128
26
粉红色
Pink+
#FF00FF
255
0
255
27
黄色
Yellow+
#FFFF00
255
255
0
28
青绿色
Turquoise+
#00FFFF
0
255
255
29
紫罗兰
Violet+
#800080
128
0
128
30
深红色
DarkRed+
#800000
128
0
0
31
青色
Teal+
#008080
0
128
128
32
蓝色
Blue+
#0000FF
0
0
255
33
天蓝色
SkyBlue
#00CCFF
0
204
255
34
浅青绿
LightTurquoise
#CCFFFF
204
255
255
35
浅绿色
LightGreen
#CCFFCC
204
255
204
36
浅黄色
LightYellow
#FFFF99
255
255
153
37
淡蓝色
PaleBlue
#99CCFF
153
204
255
38
玫瑰红
Rose
#FF99CC
255
153
204
39
淡紫色
Lavender
#CC99FF
204
153
255
40
茶色
Tan
#FFCC99
255
204
153
41
浅蓝色
LightBlue
#3366FF
51
102
255
42
水绿色
Aqua
#33CCCC
51
204
204
43
酸橙色
Lime
#99CC00
153
204
0
44
金色
Gold
#FFCC00
255
204
0
45
浅橙色
LightOrange
#FF9900
255
153
0
46
橙色
Orange
#FF6600
255
102
0
47
蓝－灰
Blue-Gray
#666699
102
102
153
48
灰－40％
Gray-40%
#969696
150
150
150
49
深青
DarkTeal
#003366
0
51
102
50
海绿
SeaGreen
#339966
51
153
102
51
深绿
DarkGreen
#003300
0
51
0
52
橄榄色
OliveGreen
#333300
51
51
0
53
褐色
Brown
#993300
153
51
0
54
梅红色
Plum
#993366
153
51
102
55
靛蓝
Indigo
#333399
51
51
153
56
灰－80％
Gray-80%
#333333
51
51
51
升级会员 