第100回目 複数ファイルの処理

○第100回目　複数ファイルの処理
　複数ファイルを対象としたマクロとしては、『第89回目　ブック(ファイル)を超えての処理の仕方』でフォルダー内のエクセルファイルに対して、置き換えの処理をするという、ひとつの形を紹介しました。
　ここでは、同一フォルダという制約を取り外してものを考えます。すなわち、与えられたフルパス名のファイルを処理対象にします。処理内容は、ある範囲のデータを集めるという処理にしました。データを集約するファイルは、別のものとなります。そのファイルを開いておいて、フルパス名、シート名、シート上のタイトルのある座標、データの座標範囲、貼付先の先頭座標をセルに書き込んで、その範囲を指定してから実行とします。
　簡単にするために、コピー元のファイルは同一形式になっているので、シート名、シート上のタイトルのある座標、データ範囲の座標はすべて同じとします。(ここを変えたいものにするにはセルにその情報を書きこんでおいて、その情報を使用してください。複雑度は増しますが、原理的には簡単だと思います。注意、貼り付ける列の数の取得も忘れずに)
　流れです。
　1.指定された範囲から、フルパス名(コピーもとのファイル、複数)、シート名(同一としたので一つ)、シート上のタイトルのある座標(同一としたので一つ)、データの座標範囲(同一としたので一つ)、貼付先での先頭ファイル用の貼付け座標(順次自動的にずらしていくので一つ)を取得します。ここで、ファイルの数を求めます。
　2.指定されたファイルを開き、シートを指定して、指定されたタイトルをコピーします。
　3.貼付先のファイルに移動し、貼付先の2行目(列はデータと同じ)に貼付ます。
　4.指定されたファイルに移動し、指定された範囲のデータをコピーします。処理が終わったらファイルは閉じておきます。
　5.貼付先のファイルに移動し、貼付先の先頭座標に貼付ます。このときは、値のほかに書式も貼り付けますので、貼付は2回となります。
　6.次のファイルを開いて、2から5をファイルの数だけ繰り返します。
　　2回目以降は、貼付先の先頭座標が、貼付けた列の数だけ変わりますので注意してください。
　1.指定された範囲から、フルパス名、シート名、データの座標範囲、貼付先の先頭座標を取得します。ここで、ファイルの数、コピーするデータの個数を求めます。
　先頭座標から下に向かって、フルパス名を取得します。
　シート名以下は、二つ隣の列にはいっています。
　準備処理として、最初のファイルの名前、シート名を取得しておきます。
　　Application.DisplayAlerts = False '警告・確認メッセージを表示しない
F_name = ActiveWorkbook.Name
sh_name0 = ActiveSheet.Name
'フルパスファイル名、シート名(一つ)、シート上のタイトルのある座標、コピー元の座標(一つ)、貼り付け座標(一つ)を取得する
　　gyo1、retu1は指定した範囲の先頭の座標です。
For i = 1 To 100
If Cells(gyo1 + i - 1, retu1) = "" Then Exit For
FName(i) = Cells(gyo1 + i - 1, retu1)
Next
f_cnt = i - 1 'ファイル数
'シート名(一つ)以下の項目
sh_name = Cells(gyo1, retu1 + 2)　　 　'シート名
title_A1 = Cells(gyo1 + 1, retu1 + 2)　'タイトルの座標
moto_A1 = Cells(gyo1 + 2, retu1 + 2)　 'コピーもとのデータの範囲座標
saki_A1 = Cells(gyo1 + 3, retu1 + 2) 　'データの貼付先の先頭座標。タイトル、ファイル名もうちますので、十分下に設定してください。
　　'貼付けるデータの列数
p1 = InStr(moto_A1, ":")
p2 = Left(moto_A1, p1 - 1)
p3 = Mid(moto_A1, p1 + 1)
retu11 = Range(p2).Column
retu12 = Range(p3).Column
retu_cnt = retu12 - retu11 + 1　　'貼付ける列の数
　　'貼付先の座標の列番号、行番号化
retu21 = Range(saki_A1).Column
gyo21 = Range(saki_A1).Row
　2 - 6の処理
'ファイルを開き、文字列を変換し、ファイルを閉じる。メッセージは表示させない。
　ll000 = 0 'コピーした間に空白列をおく場合は、1以上を入れる
For i = 1 To f_cnt
'ファイルを開く
Workbooks.Open Filename:=FName(i)
F_name1 = ActiveWorkbook.Name
Worksheets(sh_name).Select
Range(title_A1).Copy
'コピー先ファイルに戻り、タイトル(1行目)、ファイル名(2行目)を貼り付ける
Windows(F_name).Activate
Worksheets(sh_name0).Activate
Cells(1, retu21 + (i - 1) * (retu_cnt + ll000)).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Cells(2, retu21 + (i - 1) * (retu_cnt + ll000)) = F_name1
'コピー元ファイルに戻り、データを取得する
Windows(F_name1).Activate
Worksheets(sh_name).Select
Range(moto_A1).Copy
'先ファイルに戻り、データを貼り付ける
Windows(F_name).Activate
Worksheets(sh_name0).Select
Cells(gyo21, retu21 + (i - 1) * (retu_cnt + ll000)).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Cells(gyo21, retu21 + (i - 1) * (retu_cnt + ll000)).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
'コピー元ファイルに戻り、ファイルを閉じる
Windows(F_name1).Activate
ActiveWorkbook.Close SaveChanges:=True
Next
　Application.DisplayAlerts = True '警告・確認メッセージを表示する
　※実際の業務で行った例では、ファイル数は23個でした(1グループあたり)。数が多いことが考えられをますので、ファイルのフルパス名の簡単な取得も考えておくべきだと思います。筆者はエクスプローラは通常使っていませんので、どのようにスムーズに取得するのか不明です。(筆者の使っているファイラーでは、一覧表からキーボードでファイルを指定(スペースキー)して、Ctrl+Cでそれらのファイルのフルパス名がクリップボードにコピーされ、それをエクセルに貼付ければ終わりになります)
　※データを貼付後、23を4つにわけ集計することになりました。集計項目は人数と金額1,2(ともに平均)でした。問題を簡単にして、人数、金額1,2(ともに平均)がその順番で横に23個つながっています(縦項目は所属で50個あります)。たて項目ごとに4つに集約するには、どうしたらスムーズにいくのかというテーマは頭の体操となるものと思われます。(実際のやり方は、地道に加重平均を取る計算式を作っていけばいいのですが、スムーズに作成するにはどうしたらいいのかということがテーマです。平均して6個(23/4)の加重平均となります。地道にやればできますが結構大変です)

　※今回紹介したマクロは、非常に自動化の効果がありますので、違うシート、違うデータ範囲のものにまで一般化しておくと、いいと思います。