在word中如何实现批量的查找和替换

Zlr乐

在录入的族谱中，打的都是历年，比如顺治十四年、顺治十年、康熙二十八年、康熙二十年，我需要在这些所有的年后面添加一个公元多少年。       格式就是：
                     顺治十四年（公元1657年）
                     顺治十年（公元1653年）、
                     康熙二十八年（公元1689年）

最后需要在表格中这样子显示。请教高手，有什么 办法可以快速批量的换不？之前有找到一个宏代码，但是在顺治十年、十四年后面都重复提了数据，现在不知道要怎么搞了。求大神指点。


我之前添加过的是这样子的：
Sub 创建()
'
' 创建 宏
'
'
Sub 用Excel替换()
'启动Excel
Set excel_App = CreateObject("Excel.Application") '引用程序对象实例
'设置Excel为不可见
excel_App.Visible = False
'打开文件
Set excel_Book = excel_App.Workbooks.Open("E:\HongTiHuan.xlsx") '工作簿实例
Set excel_sheet = excel_Book.Worksheets("替换") '数据表实例
Xh = 1
Bth = excel_sheet.Range("A" & Xh).Value
Thw = excel_sheet.Range("B" & Xh).Value
While Bth <> ""
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = Bth '可以使用通配符了
.Replacement.Text = Thw
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Xh = Xh + 1
Bth = excel_sheet.Range("A" & Xh).Value
Thw = excel_sheet.Range("B" & Xh).Value
Wend
'关闭Excel文件
Set excel_sheet = Nothing
excel_App.ActiveWorkbook.Close savechanges:=True '保存对EXCELL进行更改。
Set excel_Book = Nothing
excel_App.Quit
Set excel_App = Nothing
End Sub



替换过来的数据会有重复的：顺治十四年（公元1657年）（公元1653年），会替换成这个样子。请问下大神，有更好的办法吗？
                  

Zlr乐

补充一下，我之前用过的是这个样子的。
Sub 创建()
'
' 创建 宏
'
'
Sub 用Excel替换()
'启动Excel
Set excel_App = CreateObject("Excel.Application") '引用程序对象实例
'设置Excel为不可见
excel_App.Visible = False
'打开文件
Set excel_Book = excel_App.Workbooks.Open("E:\HongTiHuan.xlsx") '工作簿实例
Set excel_sheet = excel_Book.Worksheets("替换") '数据表实例
Xh = 1
Bth = excel_sheet.Range("A" & Xh).Value
Thw = excel_sheet.Range("B" & Xh).Value
While Bth <> ""
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = Bth '可以使用通配符了
.Replacement.Text = Thw
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Xh = Xh + 1
Bth = excel_sheet.Range("A" & Xh).Value
Thw = excel_sheet.Range("B" & Xh).Value
Wend
'关闭Excel文件
Set excel_sheet = Nothing
excel_App.ActiveWorkbook.Close savechanges:=True '保存对EXCELL进行更改。
Set excel_Book = Nothing
excel_App.Quit
Set excel_App = Nothing
End Sub

但是返过来的数据有重复的。比如顺治十四年后面会：顺治十四年（公元1657年）（公元1653年），把出现过相同的替换过来了。请问下这个有什么 问题，还是不可以吗？

413191246se

1. Sub aaaa_族谱_批量替换_数组()
   
2.     Dim a, b, i&
   
3.    
   
4.     a = Array("顺治十四年", "顺治十年", "康熙二十八年") '数组请自行扩充！以半角逗号分隔
   
5.     b = Array("1657", "1653", "1689") '数组请自行扩充！以半角逗号分隔（请与上组一一对应）
   
6.    
   
7.     For i = 0 To UBound(a)
   
8.         With ActiveDocument.Content.Find
   
9.             .ClearFormatting
   
10.             .Text = a(i)
    
11.             .Forward = True
    
12.             .MatchWildcards = True
    
13.             Do While .Execute
    
14.                 With .Parent
    
15.                     .Font.ColorIndex = wdRed '红色/此行代码可删除！
    
16.                     .InsertAfter Text:="(公元" & b(i) & "年)"
    
17.                     .Start = .End
    
18.                 End With
    
19.             Loop
    
20.         End With
    
21.     Next
    
22. End Sub

复制代码

Zlr乐

413191246se 发表于 2021-10-27 22:03

谢谢亲的回复。我根据我之前的那个，重新建了2个表，先把大写的年份转换成阿拉伯数据的年份。在替换成我最终需要的样式就可以了。感谢感谢