別ブックのデータを集計

はじめに

　Excelの業務でフォルダ内に点在するブックから値を取りだして集計したいというケースがあります。
　データ用のブックと集計用のブックが、マクロが使えない xlsx のExcelファイルだったとしても、プログラム用のブックから操作すれば、オリジナルのブックの拡張子を変更せずに操作できます。
　つまり他人が作ったファイルでもデータ転記できるのです。
　今回は以下のようなフォルダを用意して、中にある Data1.xlsx, Data2.xlsx, Data3.xlsx のデータを 集計.xlsx の適切な場所に転記していくプログラムを書きます。
　プログラム用のブックは ProgramBook.xlsm で、同フォルダ内のブックを読み書きを行います。

　資料データは以下にありますのでダウンロードして使用してください。
　zipファイルを展開すると、フォルダができますので、その中で作業します。

　尚、ファイル中の人名や住所は全てダミーで架空のものです。

プログラムの設計

　今回は、以下のようなファイル構成になっています。

　データを取り出すブックは、Data1.xlsx, Data2.xlsx, Data3.xlsx。
　集計するブックは、集計.xlsx。
　操作用のプログラムは、ProgramBook.xlsm に書きます。

　Data1.xlsx, Data2.xlsx, Data3.xlsx は以下のような感じです。

　集計する、集計.xlsx は以下の通りです。
　Data1.xlsx, Data2.xlsx, Data3.xlsx のその日のメニュー品目ごとの合計を転記していきます。

プログラムの内容

　プログラム用のブックは ProgramBook.xlsm で、同フォルダにあるデータファイルのリストを取得します。
　集計用ファイルは、ファイル名決め打ちで取得し、開けなければエラーメッセージを出して終了します。
　プログラムの仕様として、「フォルダ」「データファイルリスト」「集計用ファイル」のパスやファイル名は、プログラム用のブックのシート上に記録してから処理を進めるようにします。
　慣れてくれば、配列やコレクションを使って値を保持しますが、配列やコレクションにはまだ触れていませんので、このような設計としました。
　そもそも、Excelのシートは二次配列と見る事ができますので、初心者のうちは大いにExcelの特典を活かしましよう。
　
　パスやファイル名が確定したら、必要ブックを開いて転記する位置を特定して転記していきます。
　これまで他のブックの転記は殆どやっていませんでしたが、ファイルをオープンする際に変数に格納してしまえば、あとはシート同士の転記とやり方は変わりません。

　プログラム用のブックは ProgramBook.xlsm は以下のようになります。
　プログラに必要な値をセルに保持させて、後は起動用のボタンがあるだけです。

実行中のブックのパスを取得

　今回は、データ用ブック、集計ブックともにプログラムを行うブックと同じフォルダにありますので、まずはフォルダを取得しておきます。

　現在開いているブックのパスは、以下のようにすれば取得できます。
　ThisWorkbook.Path
　ファイル名は、ThisWorkbook.Name で得られますので、フルパスは以下のようにすれば取得できます。
　ThisWorkbook.Path & “\” & ThisWorkbook.Name
　\ を挟み込むのを忘れないようにしましょう。

フォルダ内のファイル一覧を取得

　フォルダ内のファイル一覧を取得するにはいくつか方法がありますが、ここではDirコマンドを使った方法を示します。
　今回はシートに配置していきます。

'Dir関数を使ってフォルダ内のファイル一覧
Sub searchFileForDir()
    Dim fname As String
    
    fname = Dir(ThisWorkbook.Path & "\*.*") 'ファイルの種類を指定
    
    Do While fname <> ""
            Debug.Print fname   'ファイル名のみ取り出せる
            'Debug.Print myPath & "\" & fname    'フルパス
        fname = Dir()
    Loop

End Sub

　このプログラムを実行すると、現在実行中のブックと同じフォルダ内のファイル名をすべて取得できます。
　Dirコマンドは少し使い方が変わっていて、一回目にパス＋ファイルの種類を入れて実行すると、一つ目のファイル名を返し、二回目以降は、該当するファイルの数だけファイル名を返していきます。
　該当するファイルが無くなった場合は、空白を返すので、fname <> “”　で終了を判断できます。

　さて上のサンプルでは、Do While ～ Loop という繰り返し処理が出てきます。
　これまで繰り返し処理は For文を使ってきました。今回はこれをFor文に置き換えて使いたいと思います。

　Do While ～ Loop を For文に書き変える方法はいくつかあると思いますが、今回は以下のような方法で書き変えてみました。
　まず For の繰り返し回数を適当に大きな数にします。今回は 100回 にしましたが、1000回でも10000回でもOKです。内部にある If fname = “” Then Exit For でfnameが空白になったらFor文は抜けてしまいますので、適当な大きな数でも最後までは到達しないのです。
　最悪、fnameが空白にならないという事態でも終端はあるので無限ループになる事は避けられます。

Sub searchFileForDir()
    With Worksheets("Sheet1")

    .Range("B2") = ThisWorkbook.Path 'フォルダ名
    .Range("B3") = "集計.xlsx"       '集計ブック名

    Dim fname As String
    Dim cnt As Long
    
    fname = Dir(ThisWorkbook.Path & "\*.xls*") 'ファイルの種類を指定
    cnt = 4
    Dim i As Long
    For i = 1 To 100
        If fname = "" Then Exit For　　'空白が来たらForループを抜ける
        
        If fname <> .Range("B3") And _
           fname <> ThisWorkbook.Name Then
           
            Cells(cnt, "B") = fname
            cnt = cnt + 1
        End If     
        fname = Dir()
    Next i
    
    End With
End Sub

繰り返し処理の話で横道にそれましたが、内部のIf文に注目しましょう。
　If fname <> .Range(“B3”) And _　　　　　集計.xlsx以外
　　 fname <> ThisWorkbook.Name Then　　自分（ProgramBook.xlsm）以外

この条件分岐で、データ用のブックが取り上げられる事になります。
実行すると以下のような結果になります。

ブックを開いて変数に入れる

　ブックは開くにはフルパスを指定して開きます。このとき開いたブックはアクティブになっています。
　Workbooks.Openは、開いたブックオブジェクトを返してくれるので、それを変数に格納する事ができます。

Sub BookOpenTest()
    Dim ws As Workbook
    Set wb = Workbooks.Open(ThisWorkbook.Path & "\sample.xlsx")
End Sub

　このようにすれば、複数のブックを開いた時もすぐにアクセスできます。ただ、引数で指定したファイルが存在せずに開く事ができなかった場合にはエラーが発生してしまいます。
　エラーの対処方法については最後に解説します。

転記していく流れ

　転記していく流れですが、まず集計ブックを変数に入れておきます。
　ループは、最初にデータブックの数だけ繰り返す形になります。
　まず、データブックを開いて、年と月を調べて転記先の集計シートを取得します。

　次に集計のシートから該当する日付を特定して、集計用シートの何行目かを特定します。
転記する行が決まれば、B列からH列に値を転記すればOKです。
　プログラムコードは以下のようになります。

Sub writeData()
    Dim i As Long, j As Long
    
    Dim 集計wb As Workbook
    Dim 集計sh As Worksheet
    
    With ThisWorkbook.Worksheets("Sheet1")
    
    '集計ブックを変数にセット
    Set 集計wb = Workbooks.Open(ThisWorkbook.Path & "\" & .Range("B3"))
    
    'データシートを開いて転記
    Dim wb As Workbook
    Dim sh As Worksheet
    Dim tag As String
    Dim myDate As Date
    Dim b As Boolean
    
    'データブック数のループ
    For i = 4 To .Cells(Rows.Count, "B").End(xlUp).Row
        Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & .Cells(i, "B"))
                
        Set sh = wb.Worksheets("売上伝票")
        
        '転記先の集計シートを取得
        For j = 1 To 集計wb.Worksheets.Count
            If Year(集計wb.Worksheets(j).Range("B1")) = Year(sh.Range("B1")) And _
                Month(集計wb.Worksheets(j).Range("B1")) = Month(sh.Range("B1")) Then
                Set 集計sh = 集計wb.Worksheets(j)
                Exit For
            End If
        Next j

        '転記
        For j = 2 To 集計sh.Cells(Rows.Count, "A").End(xlUp).Row
            If 集計sh.Cells(j, "A") = sh.Range("B1") Then '日付が同じなら
                集計sh.Cells(j, "B") = sh.Cells(27, "B")
                集計sh.Cells(j, "C") = sh.Cells(27, "C")
                集計sh.Cells(j, "D") = sh.Cells(27, "D")
                集計sh.Cells(j, "E") = sh.Cells(27, "E")
                集計sh.Cells(j, "F") = sh.Cells(27, "F")
                集計sh.Cells(j, "G") = sh.Cells(27, "G")
                集計sh.Cells(j, "H") = sh.Cells(27, "H")
            End If
        Next j
        
        wb.Close SaveChanges:=False 'データブックを保存せずに閉じる
        
    Next i
    
    End With
End Sub

ブック内のシートを巡回

　集計シートは、各月ごとにシートが分かれているために、そのシートに転記するか見極めなければなりません。
　ブックにどのくらいのシートがあるかは、Worksheets.Count で得る事ができます。ワークシートが5枚あれば、
　Worksheets(1)
　Worksheets(2)
　….
　Worksheets(5) <- – – Worksheets.Count
となりますのでFor文で一つづつ見る事ができます。

開いたブックを閉じる

データ参照用ブックは、次のブックを開く前に閉じた方が良いでしょう。ブックを閉じるには、以下のようにします。

wb.Close

だた、このまま実行しますと、「変更を保存しますか？」というメッセージが出るのでいちいち対応しなければならなくなります。
このブックはデータを読み込むだけなので、セーブしないで閉じてしまえば良いでしょう。

wb.Close SaveChanges:=False 　セーブ無しで閉じる

こうする事で、ブックをセーブ無しで閉じる事ができ、確認ダイアログも出なくなります。
また、SaveChanges:=True とすればセーブして閉じるようになります。

ボタンに登録する

　今回のプログラムは、必要なファイルを探す部分と、転記するコードに分かれていました。この一連の流れを1つにまとめて ProgramBook.xlsm のシート上のボタンから起動できるようにします。

Sub main()
    Dim result As Long
    Dim myMessage As String
    myMessage = "よろしいですか？"
    result = MsgBox(myMessage, vbYesNo + vbQuestion + vbDefaultButton2, "確認")
    
    If result = vbNo Then Exit Sub
    
    Call searchFileForDir
    Call writeData
    
End Sub

　MsgBox は、ただメッセージを出して終了させるだけでなく、「はい・いいえ」などのボタンで処理を分岐させることが出来ます。

myMessage = “よろしいですか？”
result = MsgBox(myMessage, vbYesNo + vbQuestion + vbDefaultButton2, “確認”)

　上記のようにオプションをセットすると、以下のようなメッセージボックスになります。

　　メッセージボックスは、どのボタンを押したかを返してきます。ここでは、result 変数で受けて結果を判断しています。vbで始まる値（vbYesNo、vbQuestion、 vbDefaultButton2）などは、定数といい文字列で決まった値が割り当てられています。
　メッセージボックスに関するトピックは、以下を参照してください。
　・メッセージボックス

　ここでは、「いいえ」ボタンが押されたとき、result = vbNo となりプロシーシャを終了するようにしています。Exit Sub はSubプロシーシャを抜けるコマンドです。

　「いいえ」でない場合は、「はい」が押されたという事になるので、次の処理に進み、Call で2つのプロシーシャを呼んでいます。

プロシーシャをボタンに登録する

　シート上にコマンドボタンを設置するには、「開発」＞「挿入」からボタンを選択してドラッグします。ドラッグが終了すると、「マクロの登録」というダイアログが出てきますので、一覧から main というプロシーシャを選択してOKを押します。

　もし、ボタンが既になる状態であれば、右クリックから「マクロの登録」を選択すれば、ダイアログが出てきますので、ここで実行したいプロシーシャを選択できます。

ボタンを押してプログラムを実行してみてください。

まとめ

　他のブックのデータを取得したり、値を書き込むプログラムになるとハードルが高くなった感じがすると思います。
　ブックを開くために、パスやファイル名（ブック名）を探さなくてはなりませんし、開くコマンドや閉じるコマンドなども必要になってきます。
　さらに、そこから目的のシートを見つけなければなりませんので、プログラム的にはForループやIf文が増えていく感じになります。

　初心者にとっては難しいと感じるレベルだと思いますが、コードを見て何をしているか道筋がみえるようになってくれば、順調にレベルアップしていると考えていいでしょう。

　さて、今回のコードは、環境が整っている場合にエラーが出ないというだけで、想定しないファイルや、フォーマットの異なるブックが紛れ込んだりすると、途端にエラーで止まってしまうでしょう。
　次回はもう一段難しくなると思いますが、今回のコードを改善していきたいと思います。
　VBAでよく使われる手法なので、レベルアップを目指して頑張りましょう。

記事に関する質問などは、こちらからご連絡ください

　さて、今回のコードは、環境が整っている場合にエラーが出ないというだけで、想定しないファイルや、フォーマットの異なるブックが紛れ込んだりすると、途端にエラーで止まってしまうでしょう。