Word能否写出个文件1变成文件2的宏

过客fppt

1. Sub 从文件2查找内容至文件1()
   
2.     t = Timer
   
3.     Dim 文件1 As Document, 文件2 As Document
   
4.     Set 文件1 = ActiveDocument
   
5.     Dim arr, brr
   
6.     Dim i As Integer
   
7.    
   
8.     Selection.HomeKey Unit:=wdStory, Extend:=wdMove '回到文档的起点
   
9.    
   
10.     ReDim arr(1 To ActiveDocument.Paragraphs.count)
    
11.     ReDim brr(1 To ActiveDocument.Paragraphs.count)
    
12.     For Each para In ActiveDocument.Paragraphs
    
13.         ' 处理段落的操作
    
14.         i = i + 1
    
15.         arr(i) = para.Range.text
    
16.     Next para
    
17.    
    
18.     ' 将焦点返回到之前的文档
    
19. '    遍历段落
    
20.     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
    
21.     Set 文件2 = ActiveDocument
    
22.         ' 遍历段落
    
23.     文件2.Activate
    
24.     i = 1
    
25.     For Each a In arr
    
26.         '查找
    
27.         If 查找2(Left(a, Len(a) - 1), 1, 1) Then
    
28.             brr(i) = Selection.Paragraphs(1).Range.text
    
29.         Else
    
30.             brr(i) = "=：未找到" & vbCrLf
    
31.         End If
    
32.         i = i + 1
    
33.     Next
    
34.     文件2.Close
    
35.     文件1.Activate
    
36.    
    
37.     i = 0
    
38.     For Each para In ActiveDocument.Paragraphs
    
39.         ' 处理段落的操作
    
40.         i = i + 1
    
41.         para.Range.text = Left(para.Range.text, 1) & Right(brr(i), Len(brr(i)) - 1)
    
42.     Next para
    
43.    
    
44.     Set 文件1 = Nothing
    
45.     Set 文件2 = Nothing
    
46.     MsgBox "运行时间（秒）：" & Timer - t
    
47. End Sub
    
48. Function 查找2(文本, 通配符, 向下)
    
49.     Dim rng As Range
    
50.     Selection.Find.ClearFormatting
    
51.     With Selection.Find
    
52.         .text = 文本
    
53.         .Forward = 向下
    
54.         .Wrap = wdFindContinue '往复查找
    
55.         .MatchWildcards = 通配符
    
56.         .Execute
    
57.     查找2 = .Found
    
58.         .Parent.Select
    
59.     End With
    
60. End Function
    

复制代码

常扬帆

过客fppt 发表于 2024-1-28 09:23
是这样的意思吗

运行后的文件1

我不会抄，要麻烦您帮我写出来，衷心感谢！

过客fppt

常扬帆 发表于 2024-1-28 10:27
我不会抄，要麻烦您帮我写出来，衷心感谢！

代码在审核中，请耐心等待，好用请送花花，谢谢

zhanglei1371

413191246se 发表于 2024-1-27 19:23
zhanglei 老师好！提前祝过年好！——就是一个排序问题，但我怕我的代码效率不好，没敢出手。

出手吧，你的代码水平已经很厉害了

413191246se

老师 过奖了！我只是会 Word VBA 的一点皮毛，基础操作；高级高端的如：数组、函数、正则、字典、FSO 这些都不懂。现在总想重构公文自动排版宏代码，但折腾一会儿就犯困，精神不太好；我还有疑心病，总感觉代码不够精简，我想惜墨如金，字符越少越好，太多代码就如垃圾一般，感觉影响 Word 稳定。

常扬帆

过客fppt 发表于 2024-1-28 09:34

辛苦您了！您的放在J盘？我的在桌面上，它出现了问题。

过客fppt

常扬帆 发表于 2024-1-28 16:07
辛苦您了！您的放在J盘？我的在桌面上，它出现了问题。

很简单啊，你改一下就可以了啊

常扬帆

过客fppt 发表于 2024-1-28 16:30
很简单啊，你改一下就可以了啊

人太笨，改不好，改了几次，几次红灯！要麻烦您！哈哈哈哈
文件夹路径：C:\Users\Administrator\Desktop\新建文件夹

过客fppt

常扬帆 发表于 2024-1-28 18:07
人太笨，改不好，改了几次，几次红灯！要麻烦您！哈哈哈哈
文件夹路径：C:%users\Administrator\Desktop ...

代开代码编辑窗口，Ctrl+H打开替换对话框
将
J:\学习\1 书籍PDF\1 书籍PDF\办公自动化\VBA\我的VBA\练手VBA\从文件2查找内容至文件1
替换为
C:\Users\Administrator\Desktop\新建文件夹

即可

过客fppt

413191246se 发表于 2024-1-28 12:45
老师 过奖了！我只是会 Word VBA 的一点皮毛，基础操作；高级高端的如：数组、函数、正则、字典、FSO 这些 ...

其实也还好，如果是电子表格中写vba的话，用数组是会很快的，但是在word中的话，数组感觉用处不算很大，因为我要处理一些有图片的东西，所以只能设置对象，对其他的函数，正则，字典等，了解一下，然后套用就可以了。对于自己用的代码，只要能用就行，管不了那么精简。我以前录制宏的时候的代码，那些能用的我现在也不改他