word内容核对

球球是喵喵 · 发表于 2023-4-17 14:42

平时工作与公司信息披露有关，需要核对word报告里很多公司名称。肉眼识别经常会出现错误，比如说某某医药营销公司写成了某某医药公司没有发现这种情况。想问一下各位大神有没有什么方法可以实现快速核对识别word某类内容的。万分感谢。

413191246se · 发表于 2023-4-19 10:49

如果撰稿人是自己，可以新建模板文档，每次用模板即可；如果是别人拿来的文档需要检查，则可以和 VBA 宏代码来检查。楼主可提供具体示例附件上来。

球球是喵喵 · 发表于 2023-4-21 11:15

413191246se 发表于 2023-4-19 10:49
如果撰稿人是自己，可以新建模板文档，每次用模板即可；如果是别人拿来的文档需要检查，则可以和 VBA 宏代 ...

我手里一般有准确的公司名称，然后需要核对别人给我的word中的公司名称是否正确。现在一直是采用肉眼一个一个核对的方式，想问一下有没有什么简便一点的方法核对。我上传了案例文件，excel是我手中会有的准确公司名称，word是可能会存在问题的公司名称，怎么通过vba实现自动化核对呢。

球球是喵喵 · 发表于 2023-4-21 11:16

上传了案例文件

梧叶沙沙 · 发表于 2023-4-21 11:51

这个没办法的。你不清楚对方到底是多了内容还是少了内容。没有规律可循。

zpy2 · 发表于 2023-4-21 14:57

球球是喵喵发表于 2023-4-21 11:16
上传了案例文件

word中不需要分词？都是顿号(、)分割符吗
如果这样，split然后循环一下excel应该可以的

413191246se · 发表于 2023-4-22 04:16

* 楼主，请试用下面的宏。如果频繁使用可设置为热键，比如：F8
* 首先，请楼主自行将 Excel 中的所有公司名称复制到新建 Word 文档中，另存为到 D 盘，文件名为“正确公司名称”（因为 Excel 代码我不会，高手老师们会，但他们一般时候不来，我常来）。
* 找到的公司标蓝色，未找到标红色。请按 Alt + F8 打开宏名列表，第一个宏就是本宏。
* 如果代码是在 Word 2019 下面使用，请复制代码后粘贴在 Word 的新建文档中，全选，剪切，再粘贴到 VBE 中，否则，可能有乱码。

Sub a0001_Check_Company_Name()
'检查公司名称：找到蓝色，未找到红色
Dim arr, i&, j&, s$
Documents.Open FileName:="D:\正确公司名称.docx"
With Selection
.Tables(1).Select
.Rows.ConvertToText Separator:=wdSeparateByParagraphs, NestedTables:=True
.Next.Delete
i = .Paragraphs.Count
End With
ReDim arr(0 To i - 1)
For j = 0 To i - 1
arr(j) = Replace(ActiveDocument.Paragraphs(j + 1).Range.Text, vbCr, "")
Next
ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
'全文查找所有公司名称，标记为红色
With ActiveDocument
With .Content
With .Font
.NameFarEast = "宋体"
.NameAscii = "Times New Roman"
.ColorIndex = wdAuto
End With
.InsertBefore Text:=","
End With
With .Content.Find
.ClearFormatting
.Text = "公司"
.Forward = True
.MatchWildcards = True
Do While .Execute
With .Parent
.Select
With Selection
Do
.MoveStart 1, -1
Loop Until .Previous.Text Like "[!一-﨩]"
.Font.ColorIndex = wdRed
End With
End With
Loop
End With
'全文查找《正确公司名称》文档里面的公司名称，标记为蓝色
For j = 0 To i - 1
With .Content.Find
.ClearFormatting
.Text = arr(j)
.Forward = True
.MatchWildcards = True
Do While .Execute
With .Parent
.Font.Color = wdColorBlue
End With
Loop
End With
Next
.Characters.First.Delete
'附加功能：全文查找红色文字（未找到的公司名称）并放到文首
With .Content.Find
.ClearFormatting
.Font.ColorIndex = wdRed
.Forward = True
.MatchWildcards = True
Do While .Execute
With .Parent
.Select
Selection.MoveEnd
s = s & Selection.Text
Selection.Cut
End With
Loop
End With
.Content.InsertBefore Text:=s & vbCr & vbCr
With .Content.Find
.ClearFormatting
.Text = "^p^p"
.Forward = True
.MatchWildcards = False
Do While .Execute
.Parent.Select
Exit Do
Loop
End With
With Selection
.HomeKey 6, 1
.Font.ColorIndex = wdRed
.Find.Execute "(公司)?", , , 1, , , , , , "\1^p", 2
.HomeKey 6
End With
.Content.InsertBefore Text:="未找到的公司：" & vbCr
With .Paragraphs(1).Range.Font
.Name = "黑体"
.Bold = True
.Underline = wdUnderlineDouble
End With
End With
MsgBox "处理完毕！！！", 0 + 48
End Sub

复制代码

413191246se · 发表于 2023-4-22 04:24

* 请每次使用，只须打开被检查文档即可，"正确公司名称"文档无须打开（会自动打开后关闭）。

my0745 · 发表于 2023-4-23 10:31

是不是可以先核对公司名称中的关键词，如果匹配上了，就存在这个公司，在进行全名称核对，看看是否完全一致

tcdatongye · 发表于 2023-4-23 17:23

公司名称纠错

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

[求助] word内容核对

评分