複数の単語を一括置換（指定フォルダ・配下フォルダ内全ブック対象）2023.07.07 更新：2023.12.21
指定したフォルダと、その配下の全てのフォルダ内の全ブック・全シートを対象に、複数の文字列を一括で置換するマクロです。
［１つのフォルダ内のみ全ブックを対象に一括置換］はこちら
マクロを実行すると、フォルダ選択ダイアログが表示されます。
フォルダを選択すると、そのフォルダと配下フォルダのExcelブックが検索され、見つかったブックの全シートに置換処理が実行されます。
マクロ実行後に「元に戻す」機能は使用できません。
【お薦め】マクロ・プロシージャを管理する無料のツール！
Excelマクロ管理ツール
Excelマクロ管理ツール
サンプルコード2023.07.07 更新：2023.12.21
コードの貼り付け場所 VBAコードをカラーで印刷・Web掲載するためのツールはこちら
'-------------------------------------------------------------------------------- '【実行用マクロ】 指定フォルダ・配下フォルダの全ブックで任意の文字列を一括置換 '-------------------------------------------------------------------------------- ' https://excel.syogyoumujou.com/vba/replace_books_in_subordinatefolders.html '-------------------------------------------------------------------------------- Sub replaceBooksInAllSubordinateFolders() '---------------------------------------- ' 検索文字列・置換後文字列 '---------------------------------------- Dim varArray1dWhat As Variant Dim varArray1dRepl As Variant '要素毎に対【例】神田川→神奈川、チーバ→千葉、君→県 varArray1dWhat = Array("神田川", "チーバ", "君") '検索する文字列 varArray1dRepl = Array("神奈川", "千葉", "県") '置き換える文字列 '--------------------------------------------------------- ' 指定したフォルダ配下の全サブフォルダパス取得 '--------------------------------------------------------- Dim colFolderPath As New Collection If getSubordinateFolders("", colFolderPath) = -1 Then 'フォルダ選択ダイアログボックスで「キャンセル」の場合は終了 GoTo FINALLY End If '--------------------------------------------------------- ' 指定フォルダ・全サブフォルダ内の全Excelブックパスを取得 '--------------------------------------------------------- Dim colFilePath As New Collection Dim i As Long Dim j As Long Dim varFilePath As Variant For i = 1 To colFolderPath.Count '指定したフォルダ内のExcelファイルパスを取得 '※該当ファイルが存在する場合、ファイルパスが格納された1次元配列が返る varFilePath = getArray1dSpecifiedFilesPath(colFolderPath.Item(i), "xls?") 'varFilePathが配列の場合はコレクションオブジェクトにファイルパスを追加 If IsArray(varFilePath) Then For j = 0 To UBound(varFilePath) colFilePath.Add varFilePath(j) Next End If Next '--------------------------------------------------------- ' ファイルパス数が0の場合は終了 '--------------------------------------------------------- If colFilePath.Count = 0 Then MsgBox "Excelファイルは見つかりませんでした", vbInformation GoTo FINALLY End If '--------------------------------------------------------- ' 処理実行確認 '--------------------------------------------------------- If MsgBox("対象となるExcelブック：" & colFilePath.Count & vbLf & _ "置換を実行しますか？" & vbLf & _ "※ブック数やサイズによっては時間を要します", _ vbQuestion + vbYesNo) = vbNo Then GoTo FINALLY End If On Error Resume Next Application.ScreenUpdating = False Application.EnableEvents = False '--------------------------------------------------------- ' 取得したファイルパスのブックを開き全シートで置換実行 '--------------------------------------------------------- Dim bokTarget As Workbook Dim shtTarget As Worksheet For i = 1 To colFilePath.Count 'ファイルのパスがマクロ実行ブックと同じ場合は置換対象外 If colFilePath.Item(i) <> ThisWorkbook.FullName Then Set bokTarget = Workbooks.Open(colFilePath.Item(i)) For Each shtTarget In bokTarget.Worksheets 'シートの保護確認 If Not shtTarget.ProtectContents Then 'シートが保護されていない場合に置換を実行 For j = 0 To UBound(varArray1dWhat) Call replaceTargetCell(shtTarget.Cells, varArray1dWhat(j), varArray1dRepl(j)) Next End If Next 'ブックが変更されていたら保存する If bokTarget.Saved = False Then bokTarget.Save bokTarget.Close End If Next Application.EnableEvents = True Application.ScreenUpdating = True On Error GoTo 0 MsgBox "置換処理を終了しました", vbInformation FINALLY: Set colFilePath = Nothing Set colFolderPath = Nothing End Sub
'-------------------------------------------------------------------------------- ' 指定フォルダとその全ての配下フォルダのパスを取得（再帰関数） '-------------------------------------------------------------------------------- '［引数］ ' FolderPath ：対象フォルダパス ' colFolderPath：フォルダパスを格納するためのコレクションオブジェクトを指定 '［戻り値］ ' 0：成功 ' -1：フォルダ選択ダイアログボックスで「キャンセル」をクリック '［作成日］2023.07.07 ［更新日］2023.12.21 ' https://excel.syogyoumujou.com/vba/replace_books_in_subordinatefolders.html '-------------------------------------------------------------------------------- Function getSubordinateFolders(ByVal FolderPath As String, _ ByRef colFolderPath As Collection) As Long 'フォルダパスが空の場合にはフォルダ選択ダイアログボックスを表示 If FolderPath = "" Then With Application.FileDialog(msoFileDialogFolderPicker) .Title = "フォルダを選択してください" If .Show = True Then 'フォルダ選択 FolderPath = .SelectedItems(1) Else '「キャンセル」をクリックした場合は終了 getSubordinateFolders = -1 Exit Function End If End With End If 'ファイルシステムオブジェクトの生成 Dim fso As Object Set fso = CreateObject("Scripting.FileSystemObject") 'フォルダの存在確認 存在しない場合は抜ける If Not fso.FolderExists(FolderPath) Then Exit Function 'コレクションオブジェクトにフォルダパスを追加 colFolderPath.Add FolderPath 'フォルダパスにフォルダ区切文字を追加 FolderPath = FolderPath & Application.PathSeparator On Error Resume Next Dim F As Object If 0 < fso.GetFolder(FolderPath).SubFolders.Count Then 'サブフォルダ数が1以上の存在する場合配下のサブフォルダに移る For Each F In fso.GetFolder(FolderPath).SubFolders '再帰 If getSubordinateFolders(FolderPath & F.Name, colFolderPath) = -1 Then getSubordinateFolders = -1 Exit Function End If Next End If On Error GoTo 0 End Function
'-------------------------------------------------------------------------------- ' 指定フォルダ内の任意の拡張子のファイルパスを1次元配列として取得する関数 '-------------------------------------------------------------------------------- '［引数］ ' FolderPath：検索対象のフォルダパスを指定 ' Extension ：拡張子を文字列で指定 ワイルドカード使用可 ' 【指定例1】"docx" 【指定例2】"xls?" '［戻り値］ ' ファイルパスが格納された1次元配列 ' 指定した拡張子のファイルが見つからなかった場合は Empty '［作成日］2023.07.07 ［更新日］2023.12.21 ' https://excel.syogyoumujou.com/vba/replace_books_in_subordinatefolders.html '-------------------------------------------------------------------------------- Function getArray1dSpecifiedFilesPath(ByVal FolderPath As String, _ ByVal Extension As String) As Variant '指定のフォルダが存在しない場合は抜ける If Dir(FolderPath, vbDirectory) = "" Then Exit Function 'フォルダパスにフォルダ区切り文字追加 FolderPath = FolderPath & Application.PathSeparator 'フォルダ内で対象拡張子のファイルを検索 Dim strTarget As String strTarget = Dir(FolderPath & "*." & Extension) 'ファイルがなければ終了 If strTarget = "" Then Exit Function 'ファイルパスを配列に格納 Dim varArray1d() As Variant Dim lngCount As Long Do ReDim Preserve varArray1d(lngCount) varArray1d(lngCount) = FolderPath & strTarget lngCount = lngCount + 1 strTarget = Dir() '次のファイルを検索 Loop Until strTarget = "" 'ファイルがなければループから抜ける strTarget = Dir("") getArray1dSpecifiedFilesPath = varArray1d End Function
'------------------------------------------------------------------------------------- ' 対象セル範囲から任意の文字列を置換するプロシージャ '------------------------------------------------------------------------------------- '［引数］ ' rngTarget ：対象セル範囲 ' What ：検索する文字列 ' Replacement ：置き換える文字列 ' LookAt ：一致の種類 部分一致：xlPart[既定] 全体一致：xlWhole ' SearchOrder ：検索方法 1行ごと検索：xlByRows[既定] 1列ごと検索：xlByColumns ' SearchDirection：検索順 一致する次の値：xlNext[既定] 一致する前の値：xlPrevious ' MatchCase ：大文字・小文字の区別 区別する：True 区別しない：False[既定] ' MatchByte ：全角・半角の区別 区別する：True 区別しない：False[既定] '［作成日］2023.12.20 ［更新日］2023.12.21 ' https://excel.syogyoumujou.com/vba/cells_replace_allbooks.html '------------------------------------------------------------------------------------- Sub replaceTargetCell(ByRef rngTarget As Range, _ ByVal What As String, _ ByVal Replacement As String, _ Optional ByVal LookAt As XlLookAt = xlPart, _ Optional ByVal SearchOrder As XlSearchOrder = xlByRows, _ Optional ByVal MatchCase As Boolean = False, _ Optional ByVal MatchByte As Boolean = False) Call rngTarget.Replace(What, Replacement, LookAt, SearchOrder, MatchCase, MatchByte) End Sub
「検索する文字列」
シート内から検索する文字列です。
「置き換える文字列」
検索した文字列を置き換える文字列です。
検索する文字列と置き換える文字列は要素が対になっています。
要素が対であれば、要素の増減が可能です。
●サンプルファイル ダウンロード
