多处关键字符替换，要么很慢，要么死机！

相见是缘8

老师们好！

在一个长为1200多页的文档中，把下面29个不同的关键字符，一次快速替换为另外的关键字符，想请老师帮忙写个快而不会死机的代码！谢谢！

413191246se

* 相见，请备份原始文档后在示例文档上试用下面的宏。
* 请将代码（如果用 Win10-64）复制到空白文档后，全选，剪切到 VBE 中。
* 在我的《中高端联想电脑》上，运行时间 = 71.96704 秒，不知在你的电脑上是否能忍受？

1. Sub AgainTryReplace()
   
2.     ActiveWindow.ActivePane.View.Zoom.PageFit = wdPageFitBestFit
   
3.     ActiveWindow.ActivePane.View.Zoom.PageFit = wdPageFitFullPage
   
4.     Selection.HomeKey Unit:=wdStory
   
5. 
   
6.     Dim l!
   
7.     l = Timer
   
8.     With ActiveDocument.Content.Find
   
9.         .Execute "(", , , 0, , , , , , "（", 2
   
10.         .Execute ")", , , 0, , , , , , "）", 2
    
11.         .Execute "(。)(）)", , , 1, , , , , , "\2\1", 2
    
12.         .Execute "( )(）)", , , 1, , , , , , "\2", 2
    
13.         .Execute "(（)( )", , , 1, , , , , , "\1", 2
    
14.         .Execute "[-~]", , , 1, , , , , , "～", 2
    
15.         .Execute "%", , , 0, , , , , , "％", 2
    
16.         .Execute "∶", , , 0, , , , , , "：", 2
    
17.         .Execute "大枣", , , 0, , , , , , "红枣", 2
    
18.         .Execute "亦", , , 0, , , , , , "也", 2
    
19.         .Execute "盖", , , 0, , , , , , "凡", 2
    
20.         .Execute "(钱)，", , , 1, , , , , , "\1、", 2
    
21.         .Execute "(克)，", , , 1, , , , , , "\1、", 2
    
22.         .Execute "(枚)，", , , 1, , , , , , "\1、", 2
    
23.         .Execute "(两)，", , , 1, , , , , , "\1、", 2
    
24.         .Execute "(钱半)，", , , 1, , , , , , "\1、", 2
    
25.         .Execute "(两半)，", , , 1, , , , , , "\1、", 2
    
26.         .Execute "(》)日", , , 1, , , , , , "\1曰", 2
    
27.         .Execute "(曰)([.，,；∶:︰。：])", , , 1, , , , , , "\1", 2
    
28.         .Execute "(曰)", , , 1, , , , , , "\1：", 2
    
29.     End With
    
30.     MsgBox "替换完毕！用时 " & Timer - l & " 秒！", 0 + 48
    
31. End Sub

复制代码

相见是缘8

413191246se 发表于 2021-3-30 00:50
* 相见，请备份原始文档后在示例文档上试用下面的宏。
* 请将代码（如果用 Win10-64）复制到空白文档后， ...

老师好！

感谢援手！

代码测试了2次，也会死机，运行了一个多小时，我中断了程序。

这种类似文档还有几十个，不同的关键字符要替换，是我那学中医的弟弟传过来让我帮忙处理的，本想也快，分别用了数组替换（很慢很慢）和类似你的代码，替换（死机）……

老师，我的电脑是公司的，配置较低。还有更好的方法吗？

413191246se

龚老师 要出手。。。

cuteword

通过xml进行替换，应该在几秒内。

cuteword

如果你不在乎格式，这个就是一个文本文件而已，直接替换文本内容估计更快

相见是缘8

cuteword 发表于 2021-3-30 22:47
通过xml进行替换，应该在几秒内。

龚老师好！
好久不见你露面！
我不懂xml，能否请你详教！谢谢！

相见是缘8

cuteword 发表于 2021-3-30 22:47
如果你不在乎格式，这个就是一个文本文件而已，直接替换文本内容估计更快

龚老师好！
在乎格式。如用文本内的替换，要怎样一次批量替换多个不同的关键字符？还请你指教！谢谢！

相见是缘8

413191246se 发表于 2021-3-30 22:15
龚老师 要出手。。。

老师好！
有更好的方法吗？

z9bhd

试试看，
Sub lx()
    Dim ar, br(), cr(), wd1 As Document, wd As Document, d As Object
    Dim i%, s$, t$
        Set wd1 = ThisDocument
        Set wd = Documents.Open(wd1.Path & "\替换的关键字符.doc")
        With wd
        ReDim br(1 To .Paragraphs.Count - 9, 1 To 2)
        For i = 7 To .Paragraphs.Count - 3
            s = .Paragraphs(i).Range.Text: s = Left(s, Len(s) - 1)
            br(i - 6, 1) = Split(s, "替换为")(0): br(i - 6, 2) = Split(s, "替换为")(1)
        Next i
        End With
    ar = wd1.Range.Text
    For i = 1 To UBound(br)
        ar = Replace(ar, br(i, 1), br(i, 2))
    Next i
    wd1.Range.Text = ar
End Sub