複数のブックに対して同じ処理を行うには
作業で扱うブックが複数ある場合で、それら全てのブックに対して同じ処理として内容の確認や修正をしなければならない、なんてことがよくあります。
例えば、どのセルに「aaa」と書いてあるか調べたい場合や、背景色が付いているセルを「塗りつぶしなし」にしたい場合や、シート名の西暦を和暦に変えたい場合などが挙げられますが、他にもいろいろあります。
どのような参照や修正を行うのかは本当にいろいろありますが、それらの処理を行うために必要な「複数のブックに対して同じ処理をする」という処理の書き方はいずれも大体同じような書き方になります。
そこで以下で、その大体同じような書き方になる、複数のブックに対して同じ処理を行いたい場合のコードの書き方を紹介します。
複数のブックの参照を行うコード
以下のコードは、事前にブックの一覧をシートに書いてあることが前提になります。
ここでは、A1セルからブックのフルパスを書いておき、列挙された各ブックのフルパスに対してそれぞれ同じ処理を行う、というコードの書き方になります。
マクロを実行する際には、ブックのフルパスが書いてあるブックをアクティブにしていることが前提になります。
コードの内容ですが、ブックの参照のみを行い、保存はしない場合の書き方になります。
Doループの中で1ブックずつ開いて、なんか処理して、閉じる、ということを繰り返しています。
関数の先頭でエラー発生時のラベル「ERR_LABEL」を付けています。これは、ブックが存在しない場合にWorkbooks.Openでエラーが発生して処理が止まってしまうためそれを防ぐためです。ブックが存在しなかった場合はイミディエイトウィンドウにエラー情報を出力しています。
「Application.DisplayAlerts = False」はブックのループ処理を行う場合は入れておいた方がよいです。ブックによっては開くたびに自動計算が実行されるようなものがあります。例えばTODAY関数を入れていたりなどです。そのようなブックは開く度にセルの内容が変わるため、ブックを閉じるときに「保存しますか?」と聞かれることになります。マクロで実行した場合も同様で、保存確認ダイアログを表示してそこでマクロ処理が中断されてしまいます。それを避けるために「Application.DisplayAlerts = False」を入れています。
Doループの中でブックを開く「Workbooks.Open」の引数で、「ReadOnly:=True」と「IgnoreReadOnlyRecommended:=True」を指定していますが、これはどういう処理を行うかによってTrueではなくFalseを設定することもあります。
各ブックで行う処理のサンプルとして「なんか参照処理」を用意していますが、ここではブックの一番左のシートの名前をイミディエイトウィンドウに出力しています。この部分を、個別の処理に書き換えることで、複数のブックに対して同じ処理を行うことができます。
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 |
Sub BooksLoopRefer() On Error GoTo ERR_LABEL Dim r As Range '// セル(ループ中に1セルずつ下にずれる) Dim wb As Workbook '// ブック '// ブックの一覧の基点セルを指定 Set r = Range("A1") '// ブックを閉じる際の保存確認ダイアログを出さないようにする Application.DisplayAlerts = False '// シートのA列に書かれている全てのブックパスをループ Do '// 現在ループのセルにブックパスが書いていない場合はここでループを抜ける If r.Value = "" Then Exit Do End If '// ブックを開く。 '// Filename:=r.Value:現在ループのセルに書いてあるブックパスを開く。 '// ReadOnly:=True:読み取り専用で開く '// IgnoreReadOnlyRecommended:=True:読み取り専用推奨ダイアログを非表示にする Set wb = Workbooks.Open(Filename:=r.Value, ReadOnly:=True, IgnoreReadOnlyRecommended:=True) Call なんか参照処理(wb) '// ブックを閉じる Call wb.Close '// 現在ループのA列のセルの1つ下のセルを参照する Set r = r.Offset(1, 0) Loop Application.DisplayAlerts = True ERR_LABEL: If (Err.Number <> 0) Then '// エラーが発生したブックパスとエラー内容を出力 Debug.Print r.Value & " " & Err.Number & " " & Err.Description End If End Sub Sub なんか参照処理(wb As Workbook) Debug.Print wb.Worksheets(1).Name End Sub |
複数のブックの更新を行うコード
上のコードはブックを参照する場合の書き方でしたが、以下のコードはブックの内容を書き換えて上書き保存をしたい場合の書き方です。
といっても、ほとんどの部分は上のコードと同じです。違うのはブックを開くWorkbooks.Openメソッドの引数で読み取り専用で開かないようにしていることと、ブックを閉じる前にSaveメソッドで上書き保存をしている点です。他の部分は上のコードと違いはありません。
例として、「なんか更新処理」という関数を用意しています。この関数は一番左のシートのC10セルに「aaaa」を入力します。この部分を、個別の処理に書き換えることで、複数のブックに対して同じ処理を行うことができます。
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 |
Sub BooksLoopUpdate() On Error GoTo ERR_LABEL Dim r As Range '// セル(ループ中に1セルずつ下にずれる) Dim wb As Workbook '// ブック '// ブックの一覧の基点セルを指定 Set r = Range("A1") '// ブックを閉じる際の保存確認ダイアログを出さないようにする Application.DisplayAlerts = False '// シートのA列に書かれている全てのブックパスをループ Do '// 現在ループのセルにブックパスが書いていない場合はここでループを抜ける If r.Value = "" Then Exit Do End If '// ブックを開く。 '// Filename:=r.Value:現在ループのセルに書いてあるブックパスを開く。 '// IgnoreReadOnlyRecommended:=True:読み取り専用推奨ダイアログを非表示にする Set wb = Workbooks.Open(Filename:=r.Value, IgnoreReadOnlyRecommended:=True) Call なんか更新処理(wb) '// 上書き保存 Call wb.Save '// ブックを閉じる Call wb.Close '// 現在ループのA列のセルの1つ下のセルを参照する Set r = r.Offset(1, 0) Loop Application.DisplayAlerts = True ERR_LABEL: If (Err.Number <> 0) Then '// エラーが発生したブックパスとエラー内容を出力 Debug.Print r.Value & " " & Err.Number & " " & Err.Description End If End Sub Sub なんか更新処理(wb As Workbook) wb.Worksheets(1).Range("C10").Value = "aaaa" End Sub |