怎么自动将查出的重复文字在文档里高亮显示，比如标出黄色底色，请大神帮个忙。

yileida · 发表于 2019-8-16 10:28

问题说明：在BBB文档里已经列出查出的和其他文档重复的文字内容和相应的重复文档名字，现在想实现在AAA文档里自动将这些重复的文字内容标上黄色底色并添加上重复文档名字，请教各位大神怎么实现。
例子：BBB文档第一行“检查石材的品质情况，规格尺寸方正，表面平整光滑丙文档” ，能在AAA文档里将“检查石材的品质情况，规格尺寸方正，表面平整光滑” 标上底色，并在后面加上（丙文档）也标上底色。

duquancai · 发表于 2019-8-16 21:27

横看竖看左看右看上看下看，怎么看都不是重复的。

413191246se · 发表于 2019-8-16 21:49

要想自动，得用 VBA。楼主会用宏吗？

yileida · 发表于 2019-8-17 08:44

413191246se 发表于 2019-8-16 21:49
要想自动，得用 VBA。楼主会用宏吗？

会用一些EXCEL的，不知道word的通不通用。

yileida · 发表于 2019-8-17 09:45

duquancai 发表于 2019-8-16 21:27
横看竖看左看右看上看下看，怎么看都不是重复的。

右侧标黄是我想要达到的效果，文字部分是重复的

sylun · 发表于 2019-8-17 10:54

可试试如下代码：

Sub test()
'AAA文档为活动文档，且BBB文档须已打开
Dim Btext() As String
Dim Findtext() As String
Dim i As Integer
Dim j As Integer
Dim n As Integer
Application.ScreenUpdating = False
Btext = Split(Documents("BBB.docx").Range.Text, Chr(13))
Application.Options.DefaultHighlightColorIndex = wdYellow
With ActiveDocument.Content.Find
.MatchWildcards = True
.Replacement.Highlight = True
For i = 0 To UBound(Btext)
If InStr(Btext(i), vbTab) > 0 Then
ReDim Preserve Findtext(1, j)
Findtext(0, j) = Split(Btext(i), vbTab)(0)
Findtext(1, j) = Mid(Btext(i), Len(Findtext(0, j)) + 2)
Do While Right(Findtext(1, j), 1) = vbTab
Findtext(1, j) = Mid(Findtext(1, j), 1, Len(Findtext(1, j)) - 1)
Loop
If InStr(ActiveDocument.Range.Text, Findtext(0, j)) > 0 Then
.Execute Findtext:=Findtext(0, j), replacewith:="^&(" & Findtext(1, j) & ")", Replace:=wdReplaceAll
n = n + 1
End If
j = j + 1
End If
Next
End With
Application.ScreenUpdating = True
MsgBox "共找到" & n & "条BBB文档中的重复内容。" '并非AAA文档的重复条目
End Sub

复制代码

413191246se · 发表于 2019-8-17 14:02

sylun 老师厉害！把整个文档当作一个大字符串，这个思路好！整个代码，看得我似懂非懂，懵懵懂懂。

yileida · 发表于 2019-8-17 16:42

sylun 发表于 2019-8-17 10:54
可试试如下代码：

谢谢sylun老师，刚刚看见，我马上试验下。

yileida · 发表于 2019-8-17 16:47

sylun 发表于 2019-8-17 10:54
可试试如下代码：

sylun老师，完全实现我要的功能，太厉害了，请收下我的膝盖。不过代码还没懂，容我慢慢研究下。再次感谢！

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

[求助] 怎么自动将查出的重复文字在文档里高亮显示，比如标出黄色底色，请大神帮个忙。