word vba 问题求助

yang611 · 发表于 2013-7-19 16:07

以下代码为寻找word文档中未知重复的代码，来源于[size=-1]王殿佑《[size=-1]Word VBA 应用程序在处理文档未知重复内容中的应用》，
Sub SearchSamesQuickly()
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

问题：
MySearchRange.Paragraphs(1).Range.Font.Color = wdColorRed ' 整段标红
这句代码将含有重复文字的段落整段标红，能否修改为只标红重复的句子？

补充内容 (2013-7-31 08:52):
附件见 14楼

yang611 · 发表于 2013-7-19 16:44

半小时无人解答？

loquat · 发表于 2013-7-19 17:20

只是提供一个思路，代码供参考

Sub SearchSamesQuickly()
Dim i As Paragraph, oSen As Range, MySearchRange As Range
Dim MyArray() As String, aArray As Variant
On Error Resume Next
With ActiveDocument
For Each i In .Paragraphs
If VBA.Len(i.Range) = 1 Or i.Range.Start = .Content.Paragraphs.Last.Range.Start Then GoTo oNext
Set MySearchRange = .Range(i.Range.End, .Content.End)
With MySearchRange.Find '在指定的Range中查找
MyArray = VBA.Split(i.Range, "，") '由逗号为分隔符(本来在句子中循环，修改)
.ClearFormatting '清除查找格式
For Each aArray In MyArray '在"句子" 中循环,如果查找到该内容,则设置为红色
With MySearchRange.Paragraphs(1).Range.Find
.ClearFormatting
.text = aArray
.Replacement.text = "^&"
.Font.Color = wdColorRed
End With
Next
End With
oNext:
Next
End With
End Sub

复制代码

yang611 · 发表于 2013-7-22 08:37

谢谢loquat。
原文代码的还能整段标红，但您的代码无效，任何重复性的内容都标不出来，查找的循环设置是否有误？

loquat · 发表于 2013-7-22 08:56

应该是这样，但是好像还是运行不了

Sub SearchSamesQuickly()
Dim i As Paragraph, oSen As Range, MySearchRange As Range
Dim MyArray() As String, aArray As Variant
On Error Resume Next
With ActiveDocument
For Each i In .Paragraphs
If VBA.Len(i.Range) = 1 Or i.Range.Start = .Content.Paragraphs.Last.Range.Start Then GoTo oNext
Set MySearchRange = .Range(i.Range.End, .Content.End)
With MySearchRange.Find '在指定的Range中查找
MyArray = VBA.Split(i.Range, "，") '由逗号为分隔符(本来在句子中循环，修改)
.ClearFormatting '清除查找格式
For Each aArray In MyArray '在"句子" 中循环,如果查找到该内容,则设置为红色
With MySearchRange.Paragraphs(1).Range.Find
.ClearFormatting
.Text = aArray
.Replacement.ClearFormatting
.Replacement.Text = "^&"
.Replacement.Font.Color = wdColorRed
.Execute Replace:=wdReplaceAll
End With
Next
End With
oNext:
Next
End With
End Sub

复制代码

loquat · 发表于 2013-7-22 08:58

原文的功能似乎就是标示重复的段落的。

loquat · 发表于 2013-7-22 09:03

如果要查找重复的单个字可以使用Characters对象，好像没有能代表词组的对象。

yang611 · 发表于 2013-7-22 09:16

本帖最后由 yang611 于 2013-7-22 09:33 编辑

如果一段的内容很长，那要怎么判断是哪一句与其他内容重复了呢。查找重复的段落的目的也就是查找重复的句子了。
如果说能能知道是查找哪些固定的字或词组的重复，直接用word查找替换就可以了。但word中的未知重复是无法判断的啊。

继续求助

loquat · 发表于 2013-7-22 12:45

晚一点再研究一下，中午休息了。看到几个帖子供参考。
http://club.excelhome.net/thread-81429-1-1.html
http://club.excelhome.net/thread-395380-1-1.html
http://club.excelhome.net/forum. ... 380&pid=2523483

zhanglei1371 · 发表于 2013-7-22 15:14

MySearchRange.Paragraphs(1).Range.Font.Color = wdColorRed ' 整段标红
改成
.Parent.Font.Color = vbRed
就OK了

		自动登录	找回密码
密码			免费注册

[求助] word vba 问题求助

评分