用VBA在Word中，从文件2查找内容到文件1

最新推荐文章于 2024-05-29 08:38:12 发布

zhangdabai1

最新推荐文章于 2024-05-29 08:38:12 发布

阅读量506

点赞数 8

文章标签： word

本文链接：https://blog.csdn.net/zhangdabai1/article/details/135892000

版权

想要实现的目标：

完成后的效果：

添加查找不到的处理：

VBA代码：

Sub 从文件2查找内容至文件1()
    t = Timer
    Dim 文件1 As Document, 文件2 As Document
    Set 文件1 = ActiveDocument
    Dim arr, brr
    Dim i As Integer
    
    Selection.HomeKey Unit:=wdStory, Extend:=wdMove '回到文档的起点
    
    ReDim arr(1 To ActiveDocument.Paragraphs.count)
    ReDim brr(1 To ActiveDocument.Paragraphs.count)
    For Each para In ActiveDocument.Paragraphs
        ' 处理段落的操作
        i = i + 1
        arr(i) = para.Range.text
    Next para
    
    ' 将焦点返回到之前的文档
'    遍历段落
    Documents.Open FileName:="J:\学习\1 书籍PDF\1 书籍PDF\办公自动化\VBA\我的VBA\练手VBA\从文件2查找内容至文件1\文件2.docx", ConfirmConversions:=False, ReadOnly:=False, AddToRecentFiles:=True, PasswordDocument:="", PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", WritePasswordTemplate:="", Format:=0, Encoding:=0, Visible:=True, OpenAndRepair:=False, DocumentDirection:=0, NoEncodingDialog:=True
    Set 文件2 = ActiveDocument
        ' 遍历段落
    文件2.Activate
    i = 1
    For Each a In arr
        '查找
        If 查找2(Left(a, Len(a) - 1), 1, 1) Then
            brr(i) = Selection.Paragraphs(1).Range.text
        Else
            brr(i) = "=：未找到" & vbCrLf
        End If
        i = i + 1
    Next
    文件2.Close
    文件1.Activate
    
    i = 0
    For Each para In ActiveDocument.Paragraphs
        ' 处理段落的操作
        i = i + 1
        para.Range.text = Left(para.Range.text, 1) & Right(brr(i), Len(brr(i)) - 1)
    Next para
    
    Set 文件1 = Nothing
    Set 文件2 = Nothing
    MsgBox "运行时间（秒）：" & Timer - t
End Sub
Function 查找2(文本, 通配符, 向下)
    Dim rng As Range
    Selection.Find.ClearFormatting
    With Selection.Find
        .text = 文本
        .Forward = 向下
        .Wrap = wdFindContinue '往复查找
        .MatchWildcards = 通配符
        .Execute
    查找2 = .Found
        .Parent.Select
    End With
End Function