Excel VBAで複数部署の売上データを自動統合！月次集計マクロで業務効率を劇的に向上させる方法

Excel・VBA

はじめに：手作業の月次集計はもうやめませんか？

毎月の売上集計、各部署から送られてくるExcelファイルを一つずつ開いてはコピー&ペースト…。そんな手作業に膨大な時間と労力を費やしていませんか？さらに、手作業はヒューマンエラーの原因にもなりがちです。

この記事では、Excel VBAを使って複数部署に散らばる売上データを自動で統合し、月次集計を行うマクロの作成方法を解説します。一度作成すれば、ボタン一つで集計が完了し、あなたの業務効率を劇的に向上させること間違いなしです！

初級者から中級者まで、現場で今すぐ使える実用的なコードと具体的な手順を、ステップバイステップでご紹介します。

マクロで実現する月次集計の全体像

今回作成するマクロは、以下の流れで処理を進めます。

  • 特定のフォルダ内にあるすべての部署別売上ファイルを開く
  • 各ファイルから必要なデータを読み込み、一つのワークシートに集約する
  • 集約されたデータから、部署と商品ごとの売上合計を計算する
  • 計算結果を新しいワークシートに分かりやすく出力する

この一連の作業をVBAコードで自動化することで、作業時間を大幅に短縮し、常に正確な集計結果を得ることができます。

実践！VBAによるデータ統合・集計マクロの作成

ステップ0: 事前準備とフォルダ構成

まず、データ統合の対象となる部署別ファイルと、マクロを記述する「集計用マスターファイル」を用意しましょう。

推奨されるフォルダ構成は以下の通りです。

  • C:\MonthlyReport\ (親フォルダ)
    • 集計用マスター.xlsm (このマクロを記述するファイル)
    • DepartmentA_Sales.xlsx (部署Aの売上データ)
    • DepartmentB_Sales.xlsx (部署Bの売上データ)
    • DepartmentC_Sales.xlsx (部署Cの売上データ)
    • …

各部署のファイルは、以下の図のような同じ形式のデータを持っていることを前提とします。

' 各部署ファイルのデータ例 (Sheet1)
' A列: 部署名
' B列: 商品名
' C列: 売上金額

ステップ1: データの統合（各部署ファイルの読み込みと集約）

まずは、各部署のファイルを読み込み、一つのシートにデータを集約する部分を作成します。

Sub MonthlySalesAggregation()
    Dim masterWb As Workbook
    Dim masterWs As Worksheet
    Dim dataRow As Long
    Dim folderPath As String
    Dim fileName As String
    Dim sourceWb As Workbook
    Dim sourceWs As Worksheet
    Dim lastRowSource As Long
    Dim i As Long
    
    ' 画面更新と警告メッセージを一時的に停止し、処理を高速化
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Set masterWb = ThisWorkbook
    
    ' 既存の「統合データ」シートがあれば削除し、新規作成
    On Error Resume Next
    Application.DisplayAlerts = False ' シート削除時の警告を非表示
    masterWb.Sheets("統合データ").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
    
    Set masterWs = masterWb.Sheets.Add(After:=masterWb.Sheets(masterWb.Sheets.Count))
    masterWs.Name = "統合データ"
    
    ' ヘッダーの書き込み
    masterWs.Cells(1, 1).Value = "部署名"
    masterWs.Cells(1, 2).Value = "商品名"
    masterWs.Cells(1, 3).Value = "売上金額"
    dataRow = 2 ' データの書き込み開始行
    
    ' 部署別ファイルがあるフォルダパスを指定
    ' このマクロブックと同じフォルダを対象とする
    folderPath = masterWb.Path & "\"
    
    ' フォルダ内のExcelファイルを順に処理
    fileName = Dir(folderPath & "*.xlsx")
    Do While fileName <> ""
        ' マクロブック自体はスキップ
        If fileName <> masterWb.Name Then
            Set sourceWb = Workbooks.Open(folderPath & fileName, ReadOnly:=True)
            Set sourceWs = sourceWb.Sheets(1) ' 各ファイルの1シート目を対象
            
            ' データがある最終行を取得 (ヘッダー行を除く)
            lastRowSource = sourceWs.Cells(sourceWs.Rows.Count, 1).End(xlUp).Row
            
            If lastRowSource > 1 Then ' ヘッダー以外のデータがあればコピー
                ' ソースシートのA2からC列の最終行までをコピー
                sourceWs.Range("A2:C" & lastRowSource).Copy
                ' 統合シートのdataRow行から貼り付け
                masterWs.Cells(dataRow, 1).PasteSpecial xlPasteValues
                
                ' 次のデータの書き込み開始行を更新
                dataRow = masterWs.Cells(masterWs.Rows.Count, 1).End(xlUp).Row + 1
            End If
            
            sourceWb.Close SaveChanges:=False ' 変更を保存せずに閉じる
        End If
        
        fileName = Dir() ' 次のファイルを取得
    Loop
    
    ' ここまででデータ統合が完了。続いて集計処理を記述する
    ' ... (ステップ2のコードが続く)
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    MsgBox "データ統合が完了しました。", vbInformation
End Sub

コードの解説：

  • Application.ScreenUpdating = False: マクロ実行中の画面更新を停止し、処理速度を向上させます。
  • Dir(folderPath & "*.xlsx"): 指定されたフォルダ内のすべてのExcelファイル（.xlsx形式）を検索します。
  • Workbooks.Open(..., ReadOnly:=True): 各部署のファイルを読み取り専用で開きます。
  • sourceWs.Range("A2:C" & lastRowSource).Copy: ヘッダー行（1行目）を除くデータをコピーします。
  • masterWs.Cells(dataRow, 1).PasteSpecial xlPasteValues: 値のみを貼り付けます。
  • sourceWb.Close SaveChanges:=False: 開いたファイルを保存せずに閉じます。

ステップ2: 統合データの集計

統合された「統合データ」シートから、部署と商品ごとの売上合計を集計します。ここでは、VBAのDictionaryオブジェクトを使って効率的に集計を行います。

' ... (ステップ1のコードの続き)
    
    ' 集計処理を開始
    Dim summaryDict As Object
    Set summaryDict = CreateObject("Scripting.Dictionary")
    
    Dim deptName As String
    Dim productName As String
    Dim salesAmount As Double
    Dim key As String
    
    ' 統合データシートからデータを読み込み、Dictionaryで集計
    For i = 2 To masterWs.Cells(masterWs.Rows.Count, 1).End(xlUp).Row
        deptName = masterWs.Cells(i, 1).Value
        productName = masterWs.Cells(i, 2).Value
        salesAmount = masterWs.Cells(i, 3).Value
        
        ' 部署名と商品名を結合してキーとする
        key = deptName & "_" & productName
        
        If summaryDict.Exists(key) Then
            summaryDict(key) = summaryDict(key) + salesAmount
        Else
            summaryDict.Add key, salesAmount
        End If
    Next i
    
    ' ... (ステップ3のコードが続く)

コードの解説：

  • CreateObject("Scripting.Dictionary"): キーと値のペアを格納できるDictionaryオブジェクトを作成します。これにより、部署と商品の組み合わせごとに売上を効率的に管理できます。
  • key = deptName & "_" & productName: 部署名と商品名をアンダースコアで連結し、一意のキーを作成します。
  • summaryDict.Exists(key): そのキーがDictionaryに存在するかどうかを確認します。
  • summaryDict(key) = summaryDict(key) + salesAmount: 既存のキーであれば売上を加算します。
  • summaryDict.Add key, salesAmount: 新しいキーであれば追加します。

ステップ3: 集計結果の出力と整形

集計されたデータを新しいシート「月次集計」に出力し、見やすいように整形します。

' ... (ステップ2のコードの続き)
    
    ' 既存の「月次集計」シートがあれば削除し、新規作成
    On Error Resume Next
    Application.DisplayAlerts = False
    masterWb.Sheets("月次集計").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
    
    Dim summaryWs As Worksheet
    Set summaryWs = masterWb.Sheets.Add(After:=masterWs)
    summaryWs.Name = "月次集計"
    
    ' ヘッダーの書き込み
    summaryWs.Cells(1, 1).Value = "部署名"
    summaryWs.Cells(1, 2).Value = "商品名"
    summaryWs.Cells(1, 3).Value = "合計売上"
    
    Dim outputRow As Long
    outputRow = 2
    
    ' Dictionaryの内容をシートに出力
    For Each key In summaryDict.Keys
        Dim parts() As String
        parts = Split(key, "_") ' キーを部署名と商品名に分割
        
        summaryWs.Cells(outputRow, 1).Value = parts(0) ' 部署名
        summaryWs.Cells(outputRow, 2).Value = parts(1) ' 商品名
        summaryWs.Cells(outputRow, 3).Value = summaryDict(key) ' 合計売上
        outputRow = outputRow + 1
    Next key
    
    ' 見た目を整える
    With summaryWs
        .Cells.EntireColumn.AutoFit ' 列幅を自動調整
        .Range("A1:C1").Font.Bold = True ' ヘッダーを太字に
        .Range("C2:C" & outputRow - 1).NumberFormatLocal = "#,##0" ' 売上金額を数値形式に
        .Range("A1:C" & outputRow - 1).Borders.LineStyle = xlContinuous ' 罫線を追加
    End With
    
    ' 処理完了メッセージ
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    MsgBox "月次集計が完了しました！", vbInformation
End Sub

コードの解説：

  • summaryWs.Cells(1, 1).Value = "部署名": 集計シートのヘッダーを設定します。
  • For Each key In summaryDict.Keys: Dictionaryに格納されたすべてのキー（部署名_商品名）をループ処理します。
  • Split(key, "_"): キーをアンダースコアで分割し、元の部署名と商品名に戻します。
  • .Cells.EntireColumn.AutoFit: 列の幅を自動調整し、見やすくします。
  • .Range("C2:C" & outputRow - 1).NumberFormatLocal = "#,##0": 売上金額の列を通貨形式に設定します。

完全なサンプルコード

上記で紹介した3つのステップをまとめた、完全なマクロコードです。このコードをExcelのVBAエディタ（Alt + F11で開く）のThisWorkbookモジュール、または新しい標準モジュールに貼り付けて実行してください。

Sub MonthlySalesAggregation()
    Dim masterWb As Workbook
    Dim masterWs As Worksheet
    Dim dataRow As Long
    Dim folderPath As String
    Dim fileName As String
    Dim sourceWb As Workbook
    Dim sourceWs As Worksheet
    Dim lastRowSource As Long
    Dim i As Long
    
    ' 画面更新と警告メッセージを一時的に停止し、処理を高速化
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Set masterWb = ThisWorkbook
    
    ' 既存の「統合データ」シートがあれば削除し、新規作成
    On Error Resume Next
    Application.DisplayAlerts = False ' シート削除時の警告を非表示
    masterWb.Sheets("統合データ").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
    
    Set masterWs = masterWb.Sheets.Add(After:=masterWb.Sheets(masterWb.Sheets.Count))
    masterWs.Name = "統合データ"
    
    ' ヘッダーの書き込み
    masterWs.Cells(1, 1).Value = "部署名"
    masterWs.Cells(1, 2).Value = "商品名"
    masterWs.Cells(1, 3).Value = "売上金額"
    dataRow = 2 ' データの書き込み開始行
    
    ' 部署別ファイルがあるフォルダパスを指定
    ' このマクロブックと同じフォルダを対象とする
    folderPath = masterWb.Path & "\"
    
    ' フォルダ内のExcelファイルを順に処理
    fileName = Dir(folderPath & "*.xlsx")
    Do While fileName <> ""
        ' マクロブック自体はスキップ
        If fileName <> masterWb.Name Then
            Set sourceWb = Workbooks.Open(folderPath & fileName, ReadOnly:=True)
            Set sourceWs = sourceWb.Sheets(1) ' 各ファイルの1シート目を対象
            
            ' データがある最終行を取得 (ヘッダー行を除く)
            lastRowSource = sourceWs.Cells(sourceWs.Rows.Count, 1).End(xlUp).Row
            
            If lastRowSource > 1 Then ' ヘッダー以外のデータがあればコピー
                ' ソースシートのA2からC列の最終行までをコピー
                sourceWs.Range("A2:C" & lastRowSource).Copy
                ' 統合シートのdataRow行から貼り付け
                masterWs.Cells(dataRow, 1).PasteSpecial xlPasteValues
                
                ' 次のデータの書き込み開始行を更新
                dataRow = masterWs.Cells(masterWs.Rows.Count, 1).End(xlUp).Row + 1
            End If
            
            sourceWb.Close SaveChanges:=False ' 変更を保存せずに閉じる
        End If
        
        fileName = Dir() ' 次のファイルを取得
    Loop
    
    ' 集計処理を開始
    Dim summaryDict As Object
    Set summaryDict = CreateObject("Scripting.Dictionary")
    
    Dim deptName As String
    Dim productName As String
    Dim salesAmount As Double
    Dim key As String
    
    ' 統合データシートからデータを読み込み、Dictionaryで集計
    For i = 2 To masterWs.Cells(masterWs.Rows.Count, 1).End(xlUp).Row
        deptName = masterWs.Cells(i, 1).Value
        productName = masterWs.Cells(i, 2).Value
        salesAmount = masterWs.Cells(i, 3).Value
        
        ' 部署名と商品名を結合してキーとする
        key = deptName & "_" & productName
        
        If summaryDict.Exists(key) Then
            summaryDict(key) = summaryDict(key) + salesAmount
        Else
            summaryDict.Add key, salesAmount
        End If
    Next i
    
    ' 既存の「月次集計」シートがあれば削除し、新規作成
    On Error Resume Next
    Application.DisplayAlerts = False
    masterWb.Sheets("月次集計").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
    
    Dim summaryWs As Worksheet
    Set summaryWs = masterWb.Sheets.Add(After:=masterWs)
    summaryWs.Name = "月次集計"
    
    ' ヘッダーの書き込み
    summaryWs.Cells(1, 1).Value = "部署名"
    summaryWs.Cells(1, 2).Value = "商品名"
    summaryWs.Cells(1, 3).Value = "合計売上"
    
    Dim outputRow As Long
    outputRow = 2
    
    ' Dictionaryの内容をシートに出力
    For Each key In summaryDict.Keys
        Dim parts() As String
        parts = Split(key, "_") ' キーを部署名と商品名に分割
        
        summaryWs.Cells(outputRow, 1).Value = parts(0) ' 部署名
        summaryWs.Cells(outputRow, 2).Value = parts(1) ' 商品名
        summaryWs.Cells(outputRow, 3).Value = summaryDict(key) ' 合計売上
        outputRow = outputRow + 1
    Next key
    
    ' 見た目を整える
    With summaryWs
        .Cells.EntireColumn.AutoFit ' 列幅を自動調整
        .Range("A1:C1").Font.Bold = True ' ヘッダーを太字に
        .Range("C2:C" & outputRow - 1).NumberFormatLocal = "#,##0" ' 売上金額を数値形式に
        .Range("A1:C" & outputRow - 1).Borders.LineStyle = xlContinuous ' 罫線を追加
    End With
    
    ' 処理完了メッセージ
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    MsgBox "月次集計が完了しました！", vbInformation
End Sub

応用と発展：さらにマクロを強化する

今回紹介したマクロは基本的な機能ですが、以下のような改善を加えることで、さらに使いやすく、堅牢なものになります。

  • エラーハンドリングの強化: ファイルが見つからない場合や、シート名が異なる場合などに備え、より詳細なエラー処理を追加する。
  • ユーザーインターフェース: Application.FileDialogを使って、集計対象フォルダをユーザーが選択できるようにする。
  • 集計軸の変更: 部署と商品だけでなく、日付や地域など、複数の集計軸に対応できるようにコードを汎用化する。
  • ピボットテーブルの活用: VBAで統合データからピボットテーブルを自動生成し、柔軟な分析を可能にする。
  • 処理速度の最適化: 大量のデータを扱う場合は、配列にデータを読み込んでから処理を行うことで、さらに高速化が期待できます。

まとめ

Excel VBAを活用することで、複数部署に散らばるデータの統合から月次集計までの一連の作業を完全に自動化できることをご紹介しました。

手作業によるコピー&ペーストや集計は、時間だけでなく、ミスのリスクも伴います。VBAマクロを導入することで、これらの課題を解決し、あなたはより重要な分析や意思決定に時間を割くことができるようになります。

ぜひこの記事のコードを参考に、あなたの職場の月次集計業務を自動化し、劇的な効率アップを実感してください！

コメント

タイトルとURLをコピーしました