データの取り込みと集計 (手作業での操作例と、それを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の複数のファイルをまとめて取り込む」場合
について考えてみます。
ページTOPへ