Excel VBA 一括置換マクロ（コピペで使える便利機能）

Option Explicit

Sub replace_all()

    On Error GoTo err
        
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    Dim filePath As String
    Dim fileName As String
    Dim tgtSheet As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim baseSheet As Worksheet
    Set baseSheet = ActiveSheet
    Dim searchWord As Variant
    Dim replaceWord As Variant
    Dim msg As String
    
    'リストの最終行を検索
    lastRow = baseSheet.Cells(Rows.Count, "A").End(xlUp).Row

    If lastRow < 3 Then
        MsgBox "検索する文字列を設定してください。"
        End
    End If

    'ダイアログの表示処理
    filePath = Application.GetOpenFilename(Filefilter:="Microsoft Excelブック,*.xls?,csvファイル,*.csv", Title:="一括置換する対象のファイルを選択してください。")

    If filePath <> "False" Then
        
        'ファイル名のみを取得する
        fileName = Dir(filePath)
        Workbooks.Open (filePath), UpdateLinks:=1
        
        '対象ファイルの全シートを1つずつループして処理する
        For Each tgtSheet In ActiveWorkbook.Worksheets
            
            'リストの分だけ置換を繰り返す
            For i = 3 To lastRow
                
                searchWord = baseSheet.Cells(i, 1).Value
                replaceWord = baseSheet.Cells(i, 2).Value
                
                Select Case searchWord
                    Case "^", "$", "?", "*", "+", ".", "|", "{", "}", "\", "[", "]", "(", ")"
                    searchWord = "~" & searchWord
                End Select
                    
                Dim Rng As Range
                Set Rng = tgtSheet.Cells.Find(What:=searchWord, _
                                        LookAt:=xlPart, _
                                        SearchFormat:=True)
                                        
                If Rng Is Nothing And InStr(msg, baseSheet.Cells(i, 1).Value) = 0 Then
                    msg = msg & "「" & baseSheet.Cells(i, 1).Value & "」がファイル内に見つかりませんでした。" & vbCr
                Else
                    tgtSheet.Cells.Replace What:=searchWord, _
                                            Replacement:=replaceWord, _
                                            LookAt:=xlPart, _
                                            SearchFormat:=True, _
                                            ReplaceFormat:=True
                End If
            Next
        Next
        
        Workbooks(fileName).Close SaveChanges:=True
        
        If msg = "" Then
            MsgBox "一括置換処理が正常に終了しました。"
        Else
            MsgBox msg
        End If
        
    'キャンセルが選択された場合はダイアログを閉じる
    Else
        End
    End If
    
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    
    Exit Sub
err:
    MsgBox "予期せぬエラーが発生しました。"
    
End Sub