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

相见是缘8 · 发表于 2021-3-29 10:21

老师们好！

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

413191246se · 发表于 2021-3-30 00:50

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

Sub AgainTryReplace()
ActiveWindow.ActivePane.View.Zoom.PageFit = wdPageFitBestFit
ActiveWindow.ActivePane.View.Zoom.PageFit = wdPageFitFullPage
Selection.HomeKey Unit:=wdStory
Dim l!
l = Timer
With ActiveDocument.Content.Find
.Execute "(", , , 0, , , , , , "（", 2
.Execute ")", , , 0, , , , , , "）", 2
.Execute "(。)(）)", , , 1, , , , , , "\2\1", 2
.Execute "( )(）)", , , 1, , , , , , "\2", 2
.Execute "(（)( )", , , 1, , , , , , "\1", 2
.Execute "[-~]", , , 1, , , , , , "～", 2
.Execute "%", , , 0, , , , , , "％", 2
.Execute "∶", , , 0, , , , , , "：", 2
.Execute "大枣", , , 0, , , , , , "红枣", 2
.Execute "亦", , , 0, , , , , , "也", 2
.Execute "盖", , , 0, , , , , , "凡", 2
.Execute "(钱)，", , , 1, , , , , , "\1、", 2
.Execute "(克)，", , , 1, , , , , , "\1、", 2
.Execute "(枚)，", , , 1, , , , , , "\1、", 2
.Execute "(两)，", , , 1, , , , , , "\1、", 2
.Execute "(钱半)，", , , 1, , , , , , "\1、", 2
.Execute "(两半)，", , , 1, , , , , , "\1、", 2
.Execute "(》)日", , , 1, , , , , , "\1曰", 2
.Execute "(曰)([.，,；∶:︰。：])", , , 1, , , , , , "\1", 2
.Execute "(曰)", , , 1, , , , , , "\1：", 2
End With
MsgBox "替换完毕！用时 " & Timer - l & " 秒！", 0 + 48
End Sub

复制代码

相见是缘8 · 发表于 2021-3-30 11:31

本帖最后由相见是缘8 于 2021-3-30 19:00 编辑

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

老师好！

感谢援手！

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

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

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

413191246se · 发表于 2021-3-30 22:15

本帖最后由 413191246se 于 2021-3-30 23:23 编辑

龚老师要出手。。。

cuteword · 发表于 2021-3-30 22:47

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

cuteword · 发表于 2021-3-30 22:47

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

相见是缘8 · 发表于 2021-3-31 06:29

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

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

相见是缘8 · 发表于 2021-3-31 06:44

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

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

相见是缘8 · 发表于 2021-3-31 06:51

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

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

z9bhd · 发表于 2021-3-31 08:04

试试看，
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

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

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