EXCEL VBA 複数ファイル・ブック・複数シートのデータを１つのブック・シートにまとめる（集計処理・テクニック）

2021年11月13日

EXCEL VBA 複数ファイル・ブック・複数シートのデータを１つのブック・シートにまとめる（集計処理・テクニック）

●はじめに

社内でアンケート・人事考課表等の集計などを各部署からファイルで取り纏めて集計する場合、手動でファイルを一件ずつ開いて集計することも出来ますが、とても負担が掛かります。集計するファイルが20件程度のデータを集計することなら、そこまで大変ではありませんが、100件・1000件を超えるデータを一つのブックなどに纏めるとなると時間も掛かるし非常に手間も掛かります。また、手動で集計する場合は集中して作業を行わないと、間違える可能性も考えられます。今回説明するサンプルプログラムは、以前にも説明しましたが、複数のファイルデータ（ブック）を一つのファイル（ブック）に纏めるサンプルプログラムの応用編となります。前回のプログラムとの違いは、１ファイル（ブック）に１シート分のみの集計でしたが、今回のプログラムは、1ファイル（ブック）に複数シートのデータが有っても全てデータを集計して纏めるサンプルプログラムです。

●EXCEL VBA 複数ファイル・ブックの集計処理・１つのワークシートにまとめる（テクニック）

EXCEL VBA 複数ファイル・ブックの集計処理・１つのワークシートにまとめる（テクニック）

EXCEL VBA 複数ファイル・ブック・複数シートのデータを１つのブック・シートにまとめる（人事考課集計・テクニック）

●プログラム説明　（ブック・シート単位で集計）

下記のサンプルプログラムは、各部署から集まる人事考課表（1ブックに複数シートのデータが登録）を一つのブックに一覧データとして集計するサンプルプログラムです。下記のようなプログラムを作成すると様々な集計作業が簡単に行う事ができます。それでは、順番に説明いたします。

【プログラム処理手順】
●全体的なプログラムの流れ①

●人事考課ファイル（ブック）の転記②

【プログラムの実行条件】
・集計用ブック（プログラム実行ファイル）のシート名に「結果一覧」を作成する。
・人事考課ファイルを作成します。人事考課ファイルは一つのフォルダーに纏めてる。

★【サンプルプログラム】
下記のリンク先よりサンプルプログラムをダウンロードする事ができます。

●　人事考課　・・・・人事考課サンプルファイル
●　人事考課集計　・・・・人事考課集計プログラム

●利用する際は、Zipファイルを解凍して必ず利用して下さい。

※注意：あくまでもサンプルプログラムのため、実際に人事考課集計用として利用する場合は、十分検証し各利用者の責任として利用して下さい。
サンプルプログラムの使用上生じるいかなる損害（逸失利益、逸失財産、またはデータ損失等いかなる直接的損害、結果的損害、偶発的損害または特別損害等）について、一切の責任を負いません。

'
'
Sub 人事考課ファイルの取込処理()
    
    
    Dim Button, T, I As Integer
    Dim OpenExcelFileName, ExcelFileName, ExcelFilePath, FileName As String
    Dim Ws As Worksheet
     
    Application.DisplayAlerts = False  '確認メッセージを無効化します。
    
    T = 5
    
    Button = MsgBox("人事考課ファイル取込ますか？", vbYesNo + vbQuestion, "確認")
    If Button = vbYes Then
            
            OpenExcelFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xls?")  'ダイアログを表示取り込むフォルダーにあるファイルを選択します。
            
            If OpenExcelFileName <> "False" Then
                ExcelFileName = Dir(OpenExcelFileName)  '指定したファイルパスからファイル名を代入します。
                ExcelFilePath = Replace(OpenExcelFileName, ExcelFileName, "")  '指定したファイルパスを指定します。（ファイルパスからファイル名を取り除く）
            Else
                MsgBox "キャンセルされました"
                Exit Sub  'キャンセルでプログラムを終了します。
                
            End If
        
            FileName = Dir(ExcelFilePath & "*.xls?")  '指定したフォルダーから一件目のEXCELファイル（人事考課）を指定します。

            
            Do While FileName <> ""    '読み込むファイルがなくなるまで繰り返す。
                Workbooks.Open FileName:=ExcelFilePath & FileName, ReadOnly:=True, UpdateLinks:=0  'EXCELファイル（人事考課）を読取り専用で開きます。
                
                With ThisWorkbook.Worksheets("結果一覧")
                     For Each Ws In Worksheets  '読み込んだワークシート全て繰り返します。
                    
                    Ws.Activate  'データと収集する人事考課シートアクティブ表示にします。
     
                        For I = 5 To 8
                             .Cells(T, I - 4) = Cells(I, "C")  'C列のC5～C8のデータを集計(ブック：シート「結果一覧」へ転記されます。
                        Next I
                        
                        For I = 10 To 20
                             .Cells(T, I - 5) = Cells(I, "D")   'D列のD10～D20のデータのデータを集計(ブック：シート「結果一覧」へ転記されます。
                        Next I
                        
                        .Cells(T, "P") = "=SUM(E" & T & ":O" & T & ")" '列の結果合計にSUM関数を代入して合計を計算します。
                        T = T + 1  '結果一覧に転記する行を＋１加算する。
                Next Ws
  
                    ActiveWindow.Close  '読み込んだアンケートファイルと閉じます。
                    FileName = Dir() '次のファイルを指定する。
               End With

            Loop
            
            Range("B1") = T - 5  '読込件数をB１に転記する。
            
                
            MsgBox "ファイル数" & T - 5 & "件　取り込みました。"  '読込件数をMsgBoxで表示
    Else
        MsgBox "処理を中断します"
    End If
    
    Application.DisplayAlerts = True  '確認メッセージを有効化します。
    
End Sub

'