|
楼主,你好!——下面是我用 VBA 编写的一个宏,但因为你提供的替换文本单词太多,我觉得验证困难,我不确定替换结果是否正确;如果结果不正确,或对程序不满意请果断放弃之,仅供参考吧!请备份好原文件,再试用下面的宏(请同时打开 variants.txt(此文件名不要变化,否则出错)和 test.docx 文档(此文件名可以随意)后应用本宏):
- Sub aaaa_UK2US_Words_Replace()
- Dim arr, brr, i&, y$, n&, t!, s&
- If MsgBox("UK 2 US ? (or US 2 UK !)", 4 + 16, "Words Replace") = vbYes Then s = 1 Else s = 2
- t = Timer
- Documents("variants.txt").Activate
- 'arr
- ActiveDocument.Content.Find.Execute "^9*(^13)", , , 1, , , , , , "\1", 2
- ActiveDocument.Paragraphs.Last.Range.Delete
- arr = Split(ActiveDocument.Content.Text, vbCr)
- 'brr
- y = ActiveDocument.FullName
- ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
- Documents.Open FileName:=y
- ActiveDocument.Content.Find.Execute "<*^9(*^13)", , , 1, , , , , , "\1", 2
- ActiveDocument.Paragraphs.Last.Range.Delete
- brr = Split(ActiveDocument.Content.Text, vbCr)
- ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
- 'replace
- For i = 0 To UBound(arr) - 1
- With Selection
- .HomeKey 6
- With .Find
- .ClearFormatting
- If s = 1 Then
- .Text = arr(i)
- .Replacement.Text = brr(i)
- Else
- .Text = brr(i)
- .Replacement.Text = arr(i)
- End If
- .Forward = True
- .MatchWildcards = False
- .MatchWholeWord = True
- Do While .Execute
- With .Parent
- n = n + 1
- With .Font
- .Color = wdColorRed
- .Underline = wdUnderlineSingle
- End With
- .Start = .End
- End With
- Loop
- End With
- End With
- Next
- MsgBox "Replaced Words = " & n - 1 & vbCr & "Costed Time = " & Round(Timer - t, 2) & " Sec.", 0 + 48
- End Sub
复制代码 |
评分
-
1
查看全部评分
-
|