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

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

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

3、性”一一“中”或“低”，再重新启动Word2003即可。进入“工具”“宏”“VisualBasic编辑器”（或者使用快捷键Alt+Fll直接进入），出现这个界面：hlicxoEDftVlxudlBasic-Nkwmal:榄决：117画交件T瞬袒电）插A格式谓试虫运行因IR9删序侖口常助血it30,1TfS-NarrnglSubSbu*ekSuiax()=黯FnmiLi|-23Uct-lEr1T4C7)HySftwrcliK-uigw.FLFigrwpb.L(1).RingA?orit.Color=vdraljrB.AdLaopEuifith的：tf.xLEndfitlLEndSub在Norma

4、l处，右键，菜单中，增加模块，将如下实例的代码直接复制到右边的代码区即可。当然在Project里面如此操作也可以，但是只能对你要处理的文档有效，而在Normal中则保存为通用的功能了。保存，退出VisualBasic，回到原来的文档状态。运行刚刚加入的宏（可用Alt+F8直接启动）即可对当前活动的文档进行检查处理。但是如果经常使用这个功能，操作会显得有点麻烦，应在工具栏中设立一个快捷菜单。:空衣略1MicrosoftWx门丿匚丈件（D那禎祖世tSjtiQ）裘搭如Fhd些pa-苗口MSffftljf.j皿血FDF型Et述畀g13丄an聲毋回:.-一选*也J匸学.希耐団|邸$皿囈上阅读*超電.唱J

5、I1出正文稱、五号”hux%宦更緒丈熄莊m中怕衽直小怕衽总砖匣邑敲刘百无盘I庄帖设置方法为：“工具”接拖入到工具栏中。1Pa判I也函X9R浮療曲豎曲當冃=丨茎呼二=型二為国管胃“自定义”弹出如下界面，“命令”一一“宏”，将对应的功能直但拖入之后再工具栏中显示的名称是模块的名称（例如：Normal.模块l.SearchSames）。这样还不够直观，可以更名，如下操作：“重排命令”“工具栏”“格式”“更改所选内容”“命名”。工具栏选项瓦亠甦类中豐Z)具逅工。别选择类别并将命空伙此內话框拖敖至工芦JJ新建4新建新蹇卜新建网页新建电子邮件新建空白文档-更改所选內咨E-.重排命令保存于$）；iTormd

6、.请选择要重排的菜单或工具栏:滋加（A）-.重新设盂込.刪踪上移下移皿更改所选內容地）RI重新设量迅）刪除1JJ31：命名:段落检索靑单TemjilateProjecNormal.块吗.F】Ncrmal.块E.F:夏制按钮囹橡电粘贴找钮圉橡复位按齟图像E）骗辑挨齟图像更改按齟圏像ci）默认样式电总是只用交宁CI）在華单中只用女宁）圏像与文玄（A）开始一组迢）分断超锤接电）实例（查找是否存在相同的句子）：下面这段代码是可以按照句子的模式搜索文档内部全部内容的一一根据标点符号来判断句子，按照一个句子检索全文中是否出现相同的句子，并且标记为红色。SubSearchSames()DimiAsParag

7、raph,oSenAsRange,MySearchRangeAsRangeDimMyArray()AsString,aArrayAsVariantOnErrorResumeNext忽略错误WithActiveDocument遍历段落(注：原始文献资料中提供的是ThisDocument，我发现没有反应，后来改为ActiveDocument可以了)ForEachiIn.Paragraphs如果为空白段落则跳过或者到达最后一个段落则进入下一个循环IfVBA.Len(i.Range)=1Ori.Range.Start=.Content.Paragraphs.Last.Range.StartThenGo

8、ToGNSetMySearchRange=.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=wdColorRedLoo

9、pNextEndWithGN:NextEndWithEndSub实例（查找是否存在相同的字符串）网友的原始代码如下：SubFindRepeat2003()DimsAsString,s1AsString,iAsLong,nAsLongs=ActiveDocument.Contentn=3所搜索重复字符串长度Options.DefaultHighlightColorIndex=wdRed将用红色标出Fori=1ToLen(s)-2*ns1=Mid(s,i,n)IfInStr(i+Len(s1),s,s1)0ThenWithActiveDocument.Content.Find.Text=s1.Re

10、placement.Text=s1.Replacement.Highlight=True.ExecuteReplace:=wdReplaceAllEndWithExitForEndIfNextEndSub但是这个代码中，设定了n=3，当然用户可以自行更改为任意值，可是每次这样繁琐的操作，去修改代码再运行，会让用户崩溃的。因此，我设置了一个小循环，一次性搜索字符串长度在150到250之间(Form=250to150)的所有内容，每次改变一个单位长度(Step-1)。当然使用者，可以根据自己的情况，任意改变这几个参数。SubFindRepeat2003()DimsAsString,s1AsStri

11、ng,iAsLong,nAsLong,mAsInteger,kAsInteger,lAsIntegers=ActiveDocument.ContentForm=250To150Step-1所搜索重复字符串长度Options.DefaultHighlightColorIndex=wdBrightGreen将用绿色标出(其他颜色也可以任意设置，只要将wdBrightGreen改成wdBlack黑色，wdRed红色，等等，详见后面的对应表)Fori=1ToLen(s)-2*ns1=Mid(s,i,n)IfInStr(i+Len(s1),s,s1)0ThenWithActiveDocument.Con

12、tent.Find.Text=s1.Replacement.Text=s1.Replacement.Highlight=True.ExecuteReplace:=wdReplaceAllEndWithExitForEndIfNextNextmEndSub实例（清除颜色）在上述操作后，删除了相同的内容，但是保留的内容的颜色会为后续操作带来一些不便，可以用下面的小代码，一次性清楚全部文档内容的颜色标记。（当然如果原来自己标注颜色的内容也会被清除）SubClearColor2003（）清除上面代码所标的红色:ActiveDocument.Content.HighlightColorIndex=0En

13、dSub附录（颜色代码）索引号颜色16进制代码RGB0002白色White#FFFFFF2552552553红色Red#FF00002550067255鲜绿色BrightGreen#OOFFOO40Yellow#FFFFOO255255黄色粉红色青绿色255Pink#FFOOFF255255Turquoise#00FFFF1282552551289DarkR#800000绿色Green10#0080000深黄色12DarkYellow#80800012813紫罗兰Violet#80008014青色Teal#0080801516171819灰一25%灰一50%海螺色梅红色象牙色浅青绿Gray-2

14、5%Gray-50%Periwinkle#C0C0C0#808080#9999FF128128192128153128128128128192128153192128255Plum+Ivory#993366#FFFFCC#CCFFFF20LiteTurquoise102Coral22#FF808023OceanBlue#0066CC#CCCCFF24IceBlue026Pink+#FF00FF珊瑚红海蓝色冰蓝2728粉红色黄色青绿色Yellow+#FFFF0029311532552042552042552555110225520425525510212810220425512820425512

15、8255Turquoise+#00FFFF255255紫罗兰青色Violet+#800080128128128128128DarkRed+#800000Teal+#0080800SkyBlue#00CCFF332553435天蓝色浅青绿浅绿色204255363738394041浅黄色淡蓝色玫瑰红淡紫色茶色浅蓝色LightTurquoiseLightGreenLightYellowPaleBlueRoseLavenderTan42水绿色434445酸橙色金色浅橙色LightBlueAquaLimeGoldLightOrage#CCFFFF#CCFFCC#FFFF99#99CCFF#FF99CC#CC99FF#FFCC99#3366FF#33CCCC#99CC00#FFCC00#FF9900204204255153255204255515115325525525525525520425520415315320410220420420415315325520425515325520446橙色#FF6600255102047484950蓝一灰灰一40%