Word文档内部检索重复内容的VBA程序代码及使用说明.docx

1、Word文档内部检索重复内容的VBA程序代码及使用说明引言：现在信息量极大丰富，计算机的使用带来了很多的方便。但同时，在整理各种资料、撰写综述性文章、申请书、毕业论文等等情况下，特别是涉及到长文档的时候，往往会出现内容的重复出现。通常，这种重复是允许出现的，但是从文档质量来说，重复的内容在不同位置出现时，最好能够做一个变通类似的意思，换一种说法，人们读起来会流畅的多。可是很多人的习惯上是大量使用了Copy和Paste，会使读者感觉不太舒服，如果是评审人看到的话，往往就会行使其手中的权力Pass了另外一个困扰就是参考文献的重复出现问题。虽然使用EndNote等类似的文献管理软件非常方便，也可以解

2、决这个问题。但我想大部分用户可能不太会用，或者不习惯使用，这从我身边的同事、同学、学生可以知道。因此，找到一些简单的手段解决这些问题非常重要。我从网上到处去找这样的小程序，发现了利用Word宏功能实现的两段内容，挺不错的。经过实验能够使用，现在演示一下，并加以详细的解释说明，方便更多的人使用。说明： 使用者要能够熟练使用word，稍微懂一点Visual Basic语言，当然完全不懂也没有太大关系，只要按照下面做就可以，只是如果懂一点的话，更容易看懂代码，并且可以进行一些改造，使其更适合个人使用。 我用来验证的系统为Win7旗舰版和Word2003。操作演示： 启动Word2003，如果宏安全性

3、高的话，无法使用宏功能，要进行设置“工具”“宏”“安全性”“中”或“低”，再重新启动Word2003即可。 进入“工具”“宏”“Visual Basic 编辑器”（或者使用快捷键Alt+F11直接进入），出现这个界面：在Normal处，右键，菜单中，增加模块，将如下实例的代码直接复制到右边的代码区即可。当然在Project里面如此操作也可以，但是只能对你要处理的文档有效，而在Normal中则保存为通用的功能了。保存，退出Visual Basic，回到原来的文档状态。运行刚刚加入的宏（可用Alt+F8直接启动）即可对当前活动的文档进行检查处理。但是如果经常使用这个功能，操作会显得有点麻烦，应在工

4、具栏中设立一个快捷菜单。设置方法为：“工具”“自定义”弹出如下界面，“命令”“宏”，将对应的功能直接拖入到工具栏中。但拖入之后再工具栏中显示的名称是模块的名称（例如：Normal.模块1.SearchSames）。这样还不够直观，可以更名，如下操作：“重排命令”“工具栏”“格式”“更改所选内容”“命名”。实例（查找是否存在相同的句子）：下面这段代码是可以按照句子的模式搜索文档内部全部内容的根据标点符号来判断句子，按照一个句子检索全文中是否出现相同的句子，并且标记为红色。Sub SearchSames()Dim i As Paragraph, oSen As Range, MySearchRan

5、ge As RangeDim MyArray() As String, aArray As VariantOn Error Resume Next 忽略错误 With ActiveDocument 遍历段落（注：原始文献资料中提供的是ThisDocument，我发现没有反应，后来改为ActiveDocument可以了） For Each i In .Paragraphs 如果为空白段落则跳过或者到达最后一个段落则进入下一个循环 If VBA.Len(i.Range) = 1 Or i.Range.Start = .Content.Paragraphs.Last.Range.Start Then

6、 GoTo GN Set MySearchRange = .Range(i.Range.End, .Content.End) With MySearchRange.Find 在指定的RANGE 中查找 MyArray = VBA.Split(i.Range, ，) 由逗号为分隔符(本来在句子中循环，看了楼主的例子，修改) .ClearFormatting 清除查找格式 For Each aArray In MyArray 在 句子 中循环,如果查找到该内容,则设置为红色Do While .Execute(findtext:=aArray) MySearchRange.Paragraphs(1)

7、.Range.Font.Color = wdColorRedLoopNext End With GN: Next End With End Sub实例（查找是否存在相同的字符串）网友的原始代码如下：Sub FindRepeat2003()Dim s As String, s1 As String, i As Long, n As Longs = ActiveDocument.Contentn = 3 所搜索重复字符串长度Options.DefaultHighlightColorIndex = wdRed 将用红色标出For i = 1 To Len(s) - 2 * ns1 = Mid(s,

8、i, n)If InStr(i + Len(s1), s, s1) 0 ThenWith ActiveDocument.Content.Find.Text = s1.Replacement.Text = s1.Replacement.Highlight = True.Execute Replace:=wdReplaceAllEnd WithExit ForEnd IfNextEnd Sub但是这个代码中，设定了n=3，当然用户可以自行更改为任意值，可是每次这样繁琐的操作，去修改代码再运行，会让用户崩溃的。因此，我设置了一个小循环，一次性搜索字符串长度在150到250之间（For m = 250

9、 to 150）的所有内容，每次改变一个单位长度（Step -1）。当然使用者，可以根据自己的情况，任意改变这几个参数。Sub FindRepeat2003()Dim s As String, s1 As String, i As Long, n As Long, m As Integer, k As Integer, l As Integers = ActiveDocument.ContentFor m = 250 To 150 Step -1 n = m 所搜索重复字符串长度Options.DefaultHighlightColorIndex = wdBrightGreen 将用绿色标出（

10、其他颜色也可以任意设置，只要将wdBrightGreen改成wdBlack黑色，wdRed红色，等等，详见后面的对应表）For i = 1 To Len(s) - 2 * n s1 = Mid(s, i, n) If InStr(i + Len(s1), s, s1) 0 Then With ActiveDocument.Content.Find .Text = s1 .Replacement.Text = s1 .Replacement.Highlight = True .Execute Replace:=wdReplaceAll End With Exit For End IfNextNe

11、xt mEnd Sub实例（清除颜色）在上述操作后，删除了相同的内容，但是保留的内容的颜色会为后续操作带来一些不便，可以用下面的小代码，一次性清楚全部文档内容的颜色标记。（当然，如果原来自己标注颜色的内容也会被清除）Sub ClearColor2003() 清除上面代码所标的红色:ActiveDocument.Content.HighlightColorIndex = 0End Sub附录（颜色代码）索引号颜色16进制代码RGB1黑色Black#0000000002白色White#FFFFFF2552552553红色Red#FF0000255004鲜绿色Bright Green#00FF000

12、25505蓝色Blue#0000FF002556黄色Yellow#FFFF0025525507粉红色Pink#FF00FF25502558青绿色Turquoise#00FFFF02552559深红色Dark Red#8000001280010绿色Green#0080000128011深蓝色Dark Blue#0000800012812深黄色Dark Yellow#808000128128013紫罗兰Violet#800080128012814青色Teal#008080012812815灰25Gray-25%#C0C0C019219219216灰50Gray-50%#80808012812812

13、817海螺色Periwinkle#9999FF15315325518梅红色Plum+#9933661535110219象牙色Ivory#FFFFCC25525520420浅青绿Lite Turquoise#CCFFFF20425525521深紫色Dark Purple#660066102010222珊瑚红Coral#FF808025512812823海蓝色Ocean Blue#0066CC010220424冰蓝Ice Blue#CCCCFF20420425525深蓝色Dark Blue+#0000800012826粉红色Pink+#FF00FF255025527黄色Yellow+#FFFF00

14、255255028青绿色Turquoise+#00FFFF025525529紫罗兰Violet+#800080128012830深红色Dark Red+#8000001280031青色Teal+#008080012812832蓝色Blue+#0000FF0025533天蓝色Sky Blue#00CCFF020425534浅青绿Light Turquoise#CCFFFF20425525535浅绿色Light Green#CCFFCC20425520436浅黄色Light Yellow#FFFF9925525515337淡蓝色Pale Blue#99CCFF15320425538玫瑰红Rose#

15、FF99CC25515320439淡紫色Lavender#CC99FF20415325540茶色Tan#FFCC9925520415341浅蓝色Light Blue#3366FF5110225542水绿色Aqua#33CCCC5120420443酸橙色Lime#99CC00153204044金色Gold#FFCC00255204045浅橙色Light Orange#FF9900255153046橙色Orange#FF6600255102047蓝灰Blue-Gray#66669910210215348灰40Gray-40%#96969615015015049深青Dark Teal#00336605110250海绿Sea Green#3399665115310251深绿Dark Green#003300051052橄榄色Olive Green#3333005151053褐色Brown#99330015351054梅红色Plum#9933661535110255靛蓝Indigo#333399515115356灰80Gray-80%#333333515151