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

引言: 现在信息量极大丰富,计算机的使用带来了很多的方便。但同时,在整理各种资料、撰写综述性文章、MATCH_ word word文档格式规范word作业纸小票打印word模板word简历模板免费word简历 _1714210274331_0、毕业 论文 政研论文下载论文大学下载论文大学下载关于长拳的论文浙大论文封面下载 等等情况下,特别是涉及到长文档的时候,往往会出现内容的重复出现。通常,这种重复是允许出现的,但是从文档质量来说,重复的内容在不同位置出现时,最好能够做一个变通——类似的意思,换一种说法,人们读起来会流畅的多。可是很多人的习惯上是大量使用了Copy和Paste,会使读者感觉不太舒服,如果是评审人看到的话,往往就会行使其手中的权力——Pass了 另外一个困扰就是参考文献的重复出现问题。虽然使用EndNote等类似的文献管理软件非常方便,也可以解决这个问题。但我想大部分用户可能不太会用,或者不习惯使用,这从我身边的同事、同学、学生可以知道。 因此,找到一些简单的手段解决这些问题非常重要。 我从网上到处去找这样的小程序,发现了利用Word宏功能实现的两段内容,挺不错的。经过实验能够使用,现在演示一下,并加以详细的解释说明,方便更多的人使用。 说明: 使用者要能够熟练使用word,稍微懂一点Visual Basic语言,当然完全不懂也没有太大关系,只要按照下面做就可以,只是如果懂一点的话,更容易看懂代码,并且可以进行一些改造,使其更适合个人使用。 我用来验证的系统为Win7旗舰版和Word2003。 操作演示: 启动Word2003,如果宏安全性高的话,无法使用宏功能,要进行设置“工具”——“宏”——“安全性”——“中”或“低”,再重新启动Word2003即可。 进入“工具”——“宏”——“Visual Basic 编辑器”(或者使用快捷键Alt+F11直接进入),出现这个界面: 在Normal处,右键,菜单中,增加模块,将如下实例的代码直接复制到右边的代码区即可。当然在Project里面如此操作也可以,但是只能对你要处理的文档有效,而在Normal中则保存为通用的功能了。 保存,退出Visual Basic,回到原来的文档状态。运行刚刚加入的宏(可用Alt+F8 直接启动)即可对当前活动的文档进行检查处理。 但是如果经常使用这个功能,操作会显得有点麻烦,应在工具栏中设立一个快捷菜单。 设置方法为:“工具”——“自定义”弹出如下界面,“命令”——“宏”,将对应的功能直接拖入到工具栏中。 但拖入之后再工具栏中显示的名称是模块的名称(例如:Normal.模块 1.SearchSames)。这样还不够直观,可以更名,如下操作: “重排命令”——“工具栏”——“格式”——“更改所选内容”——“命名”。 实例(查找是否存在相同的句子): 下面这段代码是可以按照句子的模式搜索文档内部全部内容的——根据标点符 号来判断句子,按照一个句子检索全文中是否出现相同的句子,并且标记为红色。Sub SearchSames() Dim i As Paragraph, oSen As Range, MySearchRange As Range Dim MyArray() As String, aArray As Variant On 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 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).Range.Font.Color = wdColorRed Loop Next End With GN: Next End With End Sub 实例(查找是否存在相同的字符串) 网友的原始代码如下: Sub FindRepeat2003() Dim s As String, s1 As String, i As Long, n As Long s = ActiveDocument.Content n = 3 '所搜索重复字符串长度 Options.DefaultHighlightColorIndex = 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 If Next End Sub 但是这个代码中,设定了n=3,当然用户可以自行更改为任意值,可是每次这样繁琐的操作,去修改代码再运行,会让用户崩溃的。 因此,我设置了一个小循环,一次性搜索字符串长度在150到250之间(For m = 250 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 Integer s = ActiveDocument.Content For m = 250 To 150 Step -1 n = m '所搜索重复字符串长度 Options.DefaultHighlightColorIndex = wdBrightGreen '将用绿色标出(其他颜色也可以任意设置,只要将wdBrightGreen改成wdBlack黑色,wdRed红色,等等,详见后面的对应 表 关于同志近三年现实表现材料材料类招标技术评分表图表与交易pdf视力表打印pdf用图表说话 pdf ) 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 If Next Next m End Sub 实例(清除颜色) 在上述操作后,删除了相同的内容,但是保留的内容的颜色会为后续操作带来一些不便,可以用下面的小代码,一次性清楚全部文档内容的颜色标记。(当然,如果原来自己标注颜色的内容也会被清除) Sub ClearColor2003() '清除上面代码所标的红色: ActiveDocument.Content.HighlightColorIndex = 0 End Sub 附录(颜色代码)