【知らなくても使える】指定した行/列/範囲で複数の指定した文字列を一括置換するマクロツール（Excel VBA）

Option Explicit

'-----（設定値）------------------------
Private Const DATA_START_ROW = 9                '１．検索置換表のデータが開始する行番号
Private Const DATA_START_COLUMN = "B"           '２．検索置換表のデータが開始する列アルファベット

'-----（メッセージ）-------------------
Private Const Msg1 = "一括置換する対象のファイルを選択してください。"
Private Const Msg2 = "このExcelファイル内で一括置換処理が正常に終了しました。"
Private Const Msg3 = "指定したファイル内で一括置換処理が正常に終了しました。"
Private Const WMsg1 = "検索する文字列を設定してください。"
Private Const WMsg2 = "がファイル内に見つかりませんでした｡ "
Private Const EMsg1 = "予期せぬエラーが発生しました"
'---------------------------------------

Private TgtBook As Workbook
Private BaseSheet As Worksheet
    
'==========================================================
'このファイル内で一括置換実行ボタンを押した時に実行される処理
'==========================================================
Sub このファイル内で一括置換実行_Click()

    On Error GoTo err
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    Dim msg As String
    Set TgtBook = ActiveWorkbook
    Set BaseSheet = ActiveSheet
    
    '指定した値を検索し、置換処理をする
    Call DoReplace(msg)
    
    If msg = "" Then
        MsgBox Msg2
    Else
        MsgBox msg
    End If
        
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    
    Exit Sub
err:
    MsgBox EMsg1
    
End Sub

'==========================================================
'他ファイルを指定して一括置換実行ボタンを押した時に実行される処理
'==========================================================
Sub 他ファイルを指定して一括置換実行_Click()

    On Error GoTo err
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False

    Dim filePath As String
    Dim fileName As String
    Dim msg As String
    Set BaseSheet = ActiveSheet
    
    'ダイアログの表示処理
    filePath = Application.GetOpenFilename(Filefilter:="Microsoft Excelブック,*.xls?,csvファイル,*.csv", Title:=Msg1)

    If filePath <> "False" Then
        
        'ファイル名のみを取得する
        fileName = Dir(filePath)
        Workbooks.Open (filePath), UpdateLinks:=1

        Set TgtBook = ActiveWorkbook
        
        '指定した値を検索し、置換処理をする
        Call DoReplace(msg)
        
        TgtBook.SaveAs fileName:=fileName, Local:=True
        Workbooks(fileName).Close
        
        If msg = "" Then
            MsgBox Msg3
        Else
            MsgBox msg
        End If
        
    'キャンセルが選択された場合はダイアログを閉じる
    Else
        End
    End If
    
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.DisplayAlerts = True
    
    Exit Sub
err:
    MsgBox EMsg1
    
End Sub

'-------------------------
'指定した値を検索し、置換処理をする
'-------------------------
Sub DoReplace(msg As String)

    Dim lastRow As Long
    Dim startDataCol As Long
    
    'リストの最終行を取得する
    lastRow = BaseSheet.Cells(Rows.Count, DATA_START_COLUMN).End(xlUp).Row
    startDataCol = Columns(DATA_START_COLUMN).Column
    
    '検索、置換する表内に値がなければメッセージを表示させて処理を終了する
    If lastRow < DATA_START_ROW Then
        MsgBox WMsg1
        End
    End If
    
    Dim tmpSheet As Worksheet
    Dim tgtRng As Range
    Dim i As Long
    
    Dim allMatchFlg As Long                     '完全一致のみ対象にするフラグ
    Dim caseSensitiveFlg As Boolean             '大文字と小文字を区別するフラグ
    Dim byteFlg As Boolean                      '全角と半角を区別するフラグ
    Dim existFlg As Boolean                     '検索ワードが存在するか判断するフラグ
    
    '表内の値の分だけ置換を繰り返す
    For i = DATA_START_ROW To lastRow
        
        Dim searchWord As Variant: searchWord = BaseSheet.Cells(i, startDataCol).Value     '検索ワード
        Dim replaceWord As Variant: replaceWord = BaseSheet.Cells(i, startDataCol + 1).Value '置換ワード
        Dim tgtSheetNm As String: tgtSheetNm = BaseSheet.Cells(i, startDataCol + 2).Value      '対象とするシート
        Dim tgtRowCol As String: tgtRowCol = BaseSheet.Cells(i, startDataCol + 3).Value        '対象とする行/列/範囲
        
        If BaseSheet.Cells(i, startDataCol + 4).Value <> "" Then allMatchFlg = xlWhole _
            Else allMatchFlg = xlPart                                           '完全一致のみ対象にするフラグ
            
        If BaseSheet.Cells(i, startDataCol + 5).Value <> "" Then caseSensitiveFlg = True _
            Else caseSensitiveFlg = False                                       '大文字と小文字を区別するフラグ
            
        If BaseSheet.Cells(i, startDataCol + 6).Value <> "" Then byteFlg = True _
            Else byteFlg = False                                                '全角と半角を区別するフラグ
            
        existFlg = False                                                        '検索ワードが存在するか判断するフラグ
        
        Select Case searchWord
            Case "^", "$", "?", "*", "+", ".", "|", "{", "}", "\", "[", "]", "(", ")"
            searchWord = "~" & searchWord
        End Select
        
        '対象ファイルの全シートを1つずつループして処理する
        For Each tmpSheet In TgtBook.Worksheets
            
            '対象のシートが空白なら全てのシートを対象にし、対象のシートに値がある場合は指定されたシートのみ処理する
            If (tmpSheet.Name <> BaseSheet.Name) And _
                (tgtSheetNm = "" Or (tgtSheetNm <> "" And tgtSheetNm = tmpSheet.Name)) Then
                
                If tgtRowCol <> "" Then
                    
                    '指定した値が存在するか検索する
                    Set tgtRng = tmpSheet.Range(tgtRowCol).Find(What:=searchWord, _
                        LookAt:=allMatchFlg, MatchCase:=caseSensitiveFlg, matchbyte:=byteFlg)
                    
                    '検索した値を指定した値で置換するが存在するか検索する
                    tmpSheet.Range(tgtRowCol).Replace What:=searchWord, Replacement:=replaceWord, _
                        LookAt:=allMatchFlg, MatchCase:=caseSensitiveFlg, matchbyte:=byteFlg
                Else
                
                    Set tgtRng = tmpSheet.Cells.Find(What:=searchWord, _
                        LookAt:=allMatchFlg, MatchCase:=caseSensitiveFlg, matchbyte:=byteFlg)
    
                    tmpSheet.Cells.Replace What:=searchWord, Replacement:=replaceWord, _
                        LookAt:=allMatchFlg, MatchCase:=caseSensitiveFlg, matchbyte:=byteFlg
                
                End If

                If Not (tgtRng Is Nothing) Then
                    existFlg = True
                End If
            End If
        Next
        
        '指定した値が存在しない場合はメッセージを出力する
        If Not existFlg And InStr(msg, searchWord) = 0 Then
            msg = msg & "「" & searchWord & "」" & WMsg2 & vbCr
        End If
    Next
        
End Sub