word查找系列数据

ctcun · 发表于 2019-8-27 10:31

有20几个word里的表格数据，有没有方法可以查找一系列数据并标注上标记？
比如word1：有n个数据，a、b、c、d、e、f。。。。。
word2：有n个数据，g、h、j、k、q、p。。。。。
word3有n个数据
word4有n个数据
。。。。。。。

现在要查找a、c、h、p。。。。等，这些数据在各个word里都可能有，有没有方法可以一系列的查找这些分布在各个word里的数据并标记出来（例如标上颜色）？

谢谢各位大神~

413191246se · 发表于 2019-8-28 09:47

有方法，就是用 VBA 宏可以遍历各个文档，查找出关键词，建议楼主提供包含 1-2 个文档的附件。

hempy2100 · 发表于 2019-8-28 13:10

如下图，注意勾选使用通配符

hempy2100 · 发表于 2019-8-28 13:16

如下图，注意勾选使用通配符

ctcun · 发表于 2019-8-28 14:12

413191246se 发表于 2019-8-28 09:47
有方法，就是用 VBA 宏可以遍历各个文档，查找出关键词，建议楼主提供包含 1-2 个文档的附件。

谢谢~
如附件，excel里的一系列数据，我要在各个word里查找出来并标上颜色或者更改字体颜色！可以实现吗？谢谢~

11.rar (74.97 KB, 下载次数: 6)

413191246se · 发表于 2019-8-31 12:46

* 楼主，请备份文件后试用下面的宏：（注意：请手动复制 Excel 文件中的数据到一个新建 Word 文件中，然后执行宏，其它 Word 文件放到一个文件夹中）

Sub DIR_循环遍历文件夹_查找数字_设置格式()
Dim arr, s$, t$, h&, j&
h = ActiveDocument.Tables(1).Rows.Count
For j = 0 To h - 1
s = ActiveDocument.Tables(1).Range.Cells(j + 1).Range.Text
s = Left(s, Len(s) - 2)
t = t & "," & s
Next j
t = Right(t, Len(t) - 1)
arr = Split(t, ",")
ActiveDocument.Close savechanges:=wdDoNotSaveChanges
'''
On Error Resume Next
Dim objShell As Object, objFolder As Object, SearchPath$, DicList As Object, FileList As Object, Key, NowDic$, NowFile$, i&, FileName, FilePath, doc As Document, x&
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(0, "请选择文件夹！", 0, 0)
SearchPath = objFolder.self.Path & ""
Set objShell = Nothing
Set objFolder = Nothing
If MsgBox("请确认！是否处理文件夹 " & SearchPath & " ?", 4 + 16) = vbNo Then Exit Sub
Set DicList = CreateObject("Scripting.Dictionary")
Set FileList = CreateObject("Scripting.Dictionary")
DicList.Add SearchPath, ""
i = 0
Do While i < DicList.Count
Key = DicList.keys
NowDic = Dir(Key(i), vbDirectory)
Do While NowDic <> ""
If (NowDic <> ".") And (NowDic <> "..") Then
If (GetAttr(Key(i) & NowDic) And vbDirectory) = vbDirectory Then DicList.Add Key(i) & NowDic & "", ""
End If
NowDic = Dir()
Loop
i = i + 1
Loop
For Each Key In DicList.keys
NowFile = Dir(Key)
Do While NowFile <> ""
FileList.Add NowFile, Key
NowFile = Dir()
Loop
Next
i = 0
FileName = FileList.keys
FilePath = FileList.Items
Do While i < FileList.Count
If FilePath(i) & FileName(i) Like "*.doc*" Then
Set doc = Documents.Open(FileName:=FilePath(i) & FileName(i))
For j = 0 To h - 1
With ActiveDocument.Content.Find
.ClearFormatting
.Text = arr(j)
.Forward = True
.MatchWildcards = True
Do While .Execute
With .Parent
With .Font
.NameAscii = "Arial"
.Size = 12
.Bold = True
.Color = wdColorRed
End With
.Start = .End
End With
Loop
End With
Next j
doc.Close savechanges:=wdSaveChanges
x = x + 1
End If
i = i + 1
Loop
Set DicList = Nothing
Set FileList = Nothing
MsgBox "文件夹包含 " & i & " 个文件！" & vbCr & "共处理 Word 文档(*.docx/*.doc) " & x & " 个！", 0 + 48
End Sub

复制代码

ctcun · 发表于 2019-9-2 14:37

大神，能详细点吗？谢谢
我试了下，处理的文件事0

413191246se · 发表于 2019-9-2 15:04

楼主，请打开 Excel 文档，复制要查找的数据到一个新建 Word 文档中，执行宏，找到要处理的其它 Word 文档，继续进行……（处理前备份原文件）

ctcun · 发表于 2019-9-3 18:53

试过好几次~还是不行，晕(((φ(◎ロ◎;)φ)))

413191246se · 发表于 2019-9-3 19:42

本帖最后由 413191246se 于 2019-9-3 19:46 编辑

楼主，通过图片，可以看出，你是用 WPS 来进行文档处理的；我用的是微软 OFFICE，恐怕 VBA 宏不太适合你的情况吧！

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