マクロを使って複数ファイルの表をまとめてみたくなったので、
マクロを使って複数ファイルの表をまとめてみました。
前回記事
前回は1ファイルの読み込み→1ファイルの出力を行いました。
今回はそこから少し修正して発展させます。
VBAでやりたいこと
・指定したフォルダ内にあるファイルの表をすべて取得する
・空白行を含む表を全選択してコピーする
・取得した表を、指定した1つのファイルにまとめる
状況設定
場所 C:\work\vba
inフォルダ：読み取りたいエクセルファイルがあるフォルダ
outフォルダ：書き込みたいエクセルファイル(out.xlsx)を出力するフォルダ
test2.xlsm：マクロを実行するエクセルファイル
inフォルダ内にはファイルが複数存在しています。
これらをすべて読み込みたいです。
入力したいファイルの中身はこちら↑
表内には空白行も含まれています。
空白行も含め、表全体をコピーして一つにまとめたいです。
(※各表の開始位置はB4からで統一されているという設定です。)
入力フォルダ、出力フォルダはエクセルのシート上で指定させます。
出力はout.xlsxの名前で新規作成して保存します。
実装
今回行った実装はこんな感じです。
|
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 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 |
'複数ファイルの読み込み→別ファイルに書き込み Sub csvmerge() '変数宣言 Dim InFilename As String Dim Book_in As Workbook 'ブック(入力) Dim Book_out As Workbook 'ブック(出力) Dim Path_in As String 'フォルダパス(入力) Dim Path_out As String 'フォルダパス(出力) Dim PX As Long '座標(貼り付け位置) Dim xlLastRow As Long 'Excel自体の最終行 Dim StartRow As Long '開始行 Dim LastRow As Long '最終行 'フォルダのパスを取得 Path_in = range("F4") Path_out = range("F7") InFilename = Dir(Path_in & "\*.xlsx") '入力ファイルの開始行 StartRow = 5 '出力ファイルを新規作成して変数に格納 Set Book_out = Workbooks.Add Book_out.SaveAs Filename:=Path_out & "¥" & "out.xlsx" '出力ファイルの出力開始位置 PX = 2 '入力ファイルの数だけループ Do While InFilename <> "" '入力ファイルを開いて変数に格納 Workbooks.Open Path_in & "¥" & InFilename Set Book_in = ActiveWorkbook '入力ファイルの最終行を取得 xlLastRow = Book_in.Worksheets("Sheet1").Cells(Rows.Count, 1).Row 'Excelの最終行を取得 LastRow = Book_in.Worksheets("Sheet1").Cells(xlLastRow, 2).End(xlUp).Row 'B列の最終行を取得 '入力ファイルをコピーして出力ファイルに張り付け Book_in.Worksheets("Sheet1").Rows(StartRow & ":" & LastRow).Copy Book_out.Worksheets("Sheet1").Rows(PX) 'ブックを閉じる Book_in.Close '次の出力ファイルの書き込み位置を調整 PX = PX + LastRow - StartRow 'まだ選んでないフォルダ内のファイル名を取得 InFilename = Dir() Loop 'ブックを保存 Book_out.Save 'ブックを閉じる Book_out.Close End Sub |
パーツごとに大まかに説明します。
①指定フォルダ内のすべてのファイルを参照
ループ処理ですべてのファイルを参照しています。
|
1 2 3 4 |
'入力ファイルの数だけループ Do While InFilename <> "" #InFilenameに、Inフォルダ内にあるファイル名が入る ... Loop |
なぜループ処理が入力ファイルの数だけ実行されるかというと、
Dir関数を用いて変数InFilenameの値を取得しているからです。
|
1 2 3 4 |
<span class="crayon-v">InFilename</span> <span class="crayon-o">=</span> <span class="crayon-e">Dir</span><span class="crayon-sy">(</span><span class="crayon-v">Path</span><span class="crayon-sy">_</span>in & <span class="crayon-s">"\*.xlsx"</span><span class="crayon-sy">) '22行目</span> 'まだ選んでないフォルダ内のファイル名を取得 InFilename = Dir() '54行目 |
22行目を実行したとき、引数内のパスの配下に存在するファイル名が1つ返されます。
その後は、引数なしでDir()を実行するたびに、同条件でそれまでに取得されていないファイル名が1つ返される仕組みです。
②空白行を含む表全体をコピー
表全体の選択はCurrentRegionプロパティで可能ですが、表内に空白行があると上手くいきません。
そこで、今回は次のように実装しました。
|
1 2 |
'入力ファイルをコピーして出力ファイルに張り付け Book_in.Worksheets("Sheet1").Rows(StartRow & ":" & LastRow).Copy Book_out.Worksheets("Sheet1").Rows(PX) |
StartRowは表の開始行、LastRowは表の最終行です。
開始行から最終行までの行をまるごと選択し、出力ファイルに貼り付けるようにしています。
各表の最終行をどのように取得しているかは次の通り。
|
1 2 3 |
'入力ファイルの最終行を取得 xlLastRow = Book_in.Worksheets("Sheet1").Cells(Rows.Count, 1).Row 'Excelの最終行を取得 LastRow = Book_in.Worksheets("Sheet1").Cells(xlLastRow, 2).End(xlUp).Row 'B列の最終行を取得 |
.End(xlUp)とは、キー操作でいうctrl+↑のこと。
xlLastRow(エクセルの一番下の行)から、2番目(B)の列に対して、ctrl+↑して移動した結果たどり着いた行番号をLastRowに格納しています。
出力ファイルの貼り付け行は、変数PXで制御しています。
|
1 2 |
'次の出力ファイルの書き込み位置を調整 PX = PX + LastRow - StartRow |
表の行数分だけ次の貼り付け位置をずらす形。
結果
出力はこのようになりました。
空白行も含むすべての情報が出力されています。