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