VBA 多工作簿多关键字替换

今日收到网友求助，实现多工作簿下面多个关键字替换，一看就没看过我的前面的文章案例，之前写过一个，今日再次写下，其实原理很简单，分析下需求：

【1】问题描述：

希望对大量工作簿的全部sheet的多个关键字进行替换：

图1

对里面的红色文字按照对应关系进行替换：

图2

【2】分析思路

1：利用VBA循环打开工作簿，循环多个sheet，利用replace来进行替换

2：将图2的内容放入数组，实现多关键字替换

3：单个工作簿循环完毕后保存，关闭，再进行下一个。

【3】结果验证

代码

Sub QQ372936709()

Application.DisplayAlerts = False

Application.ScreenUpdating = False

Application.AskToUpdateLinks = False

arr = ActiveSheet.Range('a2').CurrentRegion

Dim wb As Workbook

myname = Dir(ThisWorkbook.Path & '\' & '*.xls*')

Do While myname <> ''

If myname <> ThisWorkbook.Name Then

Set wb = Workbooks.Open(ThisWorkbook.Path & '\' & myname)

For i = 1 To wb.Sheets.Count

For j = 1 To UBound(arr)

wb.Sheets(i).UsedRange.Replace arr(j, 1), arr(j, 2)

Next

Next

Application.Windows(wb.Name).Visible = True

wb.Close 1

Else

End If

myname = Dir

Loop

Application.DisplayAlerts = True

Application.ScreenUpdating = True

Application.AskToUpdateLinks = True

MsgBox '完成替换'

End Sub