データの取り込みと集計 (手作業での操作例と、それをVBAで。)
■ Excel豆知識53 |
|
53-8 そのまま取り込めるデータを一度にまとめて取り込む(VBA)
53-4でも書きましたが、「①のそのまま取り込めるデータ」を「Bの複数のファイルをまとめて取り込む」場合の
手順は
1. 「CSV保存用」フォルダにあるCSVファイルを、そこにあるだけ以下の操作を繰り返す。
2. CSVファイルを開く。
3. データを貯め込んでいる「Data」シートにデータを追加する。
4. 「取込ファイル名」シートに取り込んだファイルの名前を追加する。
5. CSVファイルを閉じる。
6. 「CSV保存用」フォルダにある全部のCSVファイルに対する処理が終わったらマクロを終了。
ということになります。
下図のように、取込用のマクロブックと同じフォルダにある「CSV保存用」フォルダにまとめて保存した
同じ形式の複数のCSVファイルを、一度にすべて取り込もうとしている訳ですが、始めにまず保存用フォ
ルダにある複数のファイル名を取得してみようと思います。
53-6ではFName = Dir(ThisWorkbook.Path & "\CSV保存用\" & Nengetu & "Data.CSV")として、インプットボッ
クスで取得したyyyymmの6ケタの数字が入った変数Nengetuを入れ込んだファイル名をDir関数で取得しま
したが、今回はFName = Dir(ThisWorkbook.Path & "\CSV保存用\*.CSV")という風にワイルドカードを利用して
「このブックと同じパスにあるCSV保存用フォルダにある○○.CSVファイル」という複数のファイル名を取
得します。(Dir関数のヘルプにも「Windows の場合、複数のファイルを指定するための "*" (アスタリスク) および
"?" (疑問符) のワイルドカード文字を使用できます。」とあります。)
FName = Dir(ThisWorkbook.Path & "\CSV保存用\*Data.CSV")として「○○Data.CSV」という名前のCSVファイル
という指定にすると、余計に紛れ込んでいる別のパターンのCSVファイルを無視することが出来るかもしれ
ません。今回は、該当するフォルダには取り込みたいCSVファイルのみが存在する、という前提でコードを
作成しています。
また、そのフォルダに入っている該当するCSVファイルがいくつあるのかわかっていませんので、繰り返し
処理にはDo...Loopを利用します。(Do...Loopについてはこちら。) Do While FName <> ""...Loop として、フ
ァイル名がある間繰り返します。
そして、今はファイル名を取得するだけですので、ファイルを開く必要はありませんから下のようなコード
になります。
Sub test()
Dim FName As String
Dim i As Long
FName = Dir(ThisWorkbook.Path & "\CSV保存用\*.CSV")
i = 2 'ファイル名書込行の初期値
Do While FName <> ""
Worksheets("取込ファイル名").Cells(i, 1).Value = FName
i = i + 1
FName = Dir()
Loop
End Sub
VBEで「表示」-「ローカルウィンドウ」として出てくるローカルウィンドウで、変数の変化を確認しなが
ら上のtestをステップ実行してみます。
最初は Fname が ""、iが0です。
ここで Fnameに「201301Data.csv」が入ります。iはまだ0です。この黄色の行が実行されると、書込行の
初期値2が入ります。
Worksheets("取込ファイル名").Cells(i, 1).Value = FNameが実行されて、「取込ファイル名」シートの
A2セルに最初のファイル名が書き込まれました。
下図の段階では FName = Dir() が実行されて、Fnameに次のファイル名「201302Data.csv」が入りました。
Dir関数のヘルプに「Dir 関数は、引数 pathname と一致する最初のファイル名を返します。それ以外のファイル名で
引数 pathname と一致するファイル名を取得するには、引数を指定せずに再び Dir 関数を呼び出してください。一致す
るファイル名がない場合は、Dir 関数は長さ 0 の文字列を返します。」とありますので、FName = Dir()とすると次の
ファイル名が入ります。 そして、Loopで上のDoに戻ります。
Do While FName <> "" ですので、Fnameが空白になるまでファイル名を書き込む操作が繰り返され、下図
のように全部のファイル名を取得し終わると、FName = Dir() が実行されて Fnameが""になりました。
ここでもう一度 Do に戻り、Do While FName <> "" の条件を満たさないので、
End Sub に実行が移り、testの実行が終了します。
なお、ここではファイル名の昇順で取得されましたが、取得の順序はExcelが勝手に決めるようです。
上ではファイル名を書き込むことだけをしてみましたが、ここにファイルを開いてデータを取り込むコード
を組み合わせます。53-6のコードとその部分は同じです。
Option Explicit
'はじめてこのコードを実行する、という設定です。他の配慮はしていません。
'1回だけの処理の想定なので、ピボットテーブルはデータ取込後に手作業で作るつもりです。
'***そのまま取り込むデータをまとめて1回で***
Sub データ取込()
Dim FName As String
Dim DataBk As Workbook
Dim LastRow As Long
Dim i As Long
FName = Dir(ThisWorkbook.Path & "\CSV保存用\*.CSV")
i = 2 'ファイル名書込行の初期値
Application.ScreenUpdating = False
Do While FName <> ""
Workbooks.Open ThisWorkbook.Path & "\CSV保存用\" & FName
Set DataBk = ActiveWorkbook
With ThisWorkbook
With .Worksheets("Data")
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
DataBk.Worksheets(1).Range("A1").CurrentRegion.Offset(1).Copy _
Destination:=.Cells(LastRow + 1, 1)
End With
.Worksheets("取込ファイル名").Cells(i, 1).Value = FName
i = i + 1
End With
DataBk.Close SaveChanges:=False
FName = Dir()
Loop
Application.ScreenUpdating = True
MsgBox "データの取込を終了しました。"
End Sub
これで、「①のそのまま取り込めるデータ」を「Bの複数のファイルをまとめて取り込む」場合のコード
が出来ました。
次は、「②の何らかの抽出を行って取り込むデータ」を「Bの複数のファイルをまとめて取り込む」場合
について考えてみます。