【初心者向け】コード別の日別集計と折線グラフ自動マクロの作り方

2025年5月10日 2025年5月18日

「毎日の集計作業、もっとラクにできないかな…」

そんなお悩み、Excelマクロで一発解決できます！

本記事では、コードごと（担当者、得意先、商品など）ごとに日別集計を行い、さらに自動で折れ線グラフも作成してくれるExcel VBAマクロをご紹介します。

初心者でも安心して使える「フォーム付き」の設計で、集計・グラフ作成・保存まで全自動。

「Excelマクロって難しそう」と感じていたあなたにこそ、試してほしい内容です！

ぜひご自身の作業に合わせて使ってみてください。

初心者向けコピペOK

・初心者向けエクセルマクロの作り方を解説｜コピペOK実務テンプレ付き

・【初心者向け】シートデータをコード別に自動で分けるマクロの作り方

・【初心者向け】シートデータをコード別に自動集計するマクロの作り方

・【初心者向け】コード別の日別集計と折線グラフ自動マクロの作り方⇐ココ

・【初心者向け】日別集計と折線グラフをシート名保存するマクロの作り方

1 初心者向けマクロの作り方｜コード別の日別集計と折線グラフ作成はどんなときに便利？
2 初心者向けマクロの作り方｜コード別の日別集計と折線グラフ作成できること
3 初心者向けマクロの作り方｜コード別の日別集計と折線グラフ作成の使い方はたったの3ステップ
4 初心者向けマクロの作り方｜コード別の日別集計と折線グラフ作成｜押さえるべき3つのポイント
5 初心者向けマクロの作り方｜コード別の日別集計と折線グラフ作成｜よく変更が行われる箇所
6 初心者向けマクロの作り方｜コード別の日別集計と折線グラフ作成【検証済】コード
7 初心者向けマクロの作り方｜コードごとの自動集計シート作成【検証済】コードの使い方
8 初心者向けマクロの作り方｜コード別の日別集計と折線グラフ作成であなたの作業はもっと楽になる
9 初心者向けマクロの作り方｜もし、ダメだ動かない。わからないなど気になることがあれば・・・

初心者向けマクロの作り方｜コード別の日別集計と折線グラフ作成はどんなときに便利？

Excelシートに同じ表形式のデータが大量にあるとき、「コードごとに別のシートに分けて、集計表とグラフを作成して保存したい…」ということはありませんか？

たとえば

・毎日の売上や作業データを「コードごと（担当者、得意先、商品など）」に「日別で」集計したい

・見やすい「折れ線グラフ」も自動で作って、上司にすぐ報告したい

・手作業での集計やグラフ作成に時間を取られたくない！

そんなあなたにピッタリなのが、この「コードごとに自動でシートを分けて集計とグラフを自動作成するマクロ」です。

ファイルを選んで集計ボタンを押すだけで、自動で集計＋折れ線グラフも作成。

Excel初心者の方でも安心して使えます。

初心者向けマクロの作り方｜コード別の日別集計と折線グラフ作成できること

1枚のシートにまとめられたデータから、指定したコード列、日付列、金額列をもとに、コードごと日付、金額で集計し、コードごとにシートを分けて転記。そして、転記した内容をもとに折れ線グラフを作成

手作業不要！「マクロ実行」だけですぐに完成します。

初心者向けマクロの作り方｜コード別の日別集計と折線グラフ作成の使い方はたったの3ステップ

1. 元データをExcelに準備する。

2. マクロを起動（フォームから対象のExcelとコード列を指定）

3. 各コードごとのシートが自動で作成されます。

もう、手作業でフィルタしてコピー＆ペーストした後、集計する必要はありません。

初心者向けマクロの作り方｜コード別の日別集計と折線グラフ作成｜押さえるべき3つのポイント

①モジュール構成を覚えよう

「ThisWorkbook」→ 起動時にフォーム表示

「UserForm」→ フォームの見た目と操作

「標準モジュール」→ 実際の分割処理

②対象Excelフォーマット

コード列を統一しておく（たとえば、担当者コードはA列に統一する、日付列はB列、金額列はC列など）

③トラブル対策

マクロを実行する前に、対象のExcelファイルをバックアップする（別フォルダにコピーをとる）

初心者向けマクロの作り方｜コード別の日別集計と折線グラフ作成｜よく変更が行われる箇所

変更箇所（追加）	内容	たとえば、このように変更
グラフの種類を変更したい	標準モジュール（Module1）	.ChartType = xlLine を別の種類に変更（例：xlColumnで棒グラフ）
グラフの位置を変えたい	Set chartObj = ws.ChartObjects.Add(Left:=300, Top:=10, Width:=500, Height:=300)	.Left や .Top の数値を調整
グラフにタイトルをつけたい	.HasTitle = Trueのあとに	.ChartTitle.Text = "タイトル名"

初心者向けマクロの作り方｜コード別の日別集計と折線グラフ作成【検証済】コード

シートごとにコード別日別集計＆折線グラフを作成する【検証済】マクロコード一式（フォーム＋標準モジュール＋ThisWorkbook）を紹介します。

ThisWorkbook モジュール

xlsmファイルを開いたときに自動でフォームを表示するコードです。

Option Explicit
Private Sub Workbook_Open()
UserForm1.Show vbModeless
End Sub

Option Explicit
Private Sub Workbook_Open()
UserForm1.Show vbModeless
End Sub

フォーム

フォームのデザイン

オブジェクト名	種類	キャプション
変更しない	Label	対象Excelファイル
txtFile	TextBox	空白
btnBrowse	CommandButton	ファイル選択
変更しない	Label	コード列（例：A）
txtCodeCol	TextBox	空白
変更しない	Label	日付列（例：A）
txtDateCol	TextBox	空白
変更しない	Label	金額列（例：A）
txtAmountCol	TextBox	空白
btnAggregate	CommandButton	集計＆グラフ
btnClose	CommandButton	終了

フォームのコード（UserForm1）

Option Explicit
Private Sub UserForm_Initialize()
' Excelウィンドウを最小化し、フォームを前面に出す
Application.WindowState = xlMinimized
Me.StartUpPosition = 1 ' 画面中央
Me.Show vbModeless
End Sub
Private Sub btnBrowse_Click()
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.Title = "Excelファイルを選択してください"
.Filters.Clear
.Filters.Add "Excelファイル", "*.xlsx; *.xlsm; *.xls"
If .Show = -1 Then
txtFile.Text = .SelectedItems(1)
End If
End With
End Sub
Private Sub btnAggregate_Click()
If txtFile.Text = "" Or txtCodeCol.Text = "" Or txtDateCol.Text = "" Or txtAmountCol.Text = "" Then
MsgBox "ファイルと各列をすべて指定してください", vbExclamation
Exit Sub
End If
If txtCodeCol.Text = txtDateCol.Text Then
MsgBox "コード列と日付列に同じ値は指定できません", vbExclamation
Exit Sub
End If
If txtCodeCol.Text = txtAmountCol.Text Then
MsgBox "コード列と金額列に同じ値は指定できません", vbExclamation
Exit Sub
End If
If txtDateCol.Text = txtAmountCol.Text Then
MsgBox "日付列と金額列に同じ値は指定できません", vbExclamation
Exit Sub
End If
Application.ScreenUpdating = False
Dim colLetter As String
colLetter = UCase(txtCodeCol.Text) ' 大文字に統一
' 列記号が正しいかと、2行目のセルに値があるか確認
Dim wb As Workbook
Set wb = Workbooks.Open(txtFile.Text)
Dim srcWs As Worksheet
Set srcWs = wb.Sheets(1) ' 最初のシートを対象に
Dim checkValue As Variant
On Error Resume Next
checkValue = srcWs.Range(colLetter & "2").Value
On Error GoTo 0
' コード列記号の妥当性チェック
If Not IsValidColumnLetter(colLetter) Then
MsgBox "コード列記号が無効です。" & vbCrLf & "A ? XFD の範囲で入力してください。", vbExclamation
Application.ScreenUpdating = True ' MsgBox後に復元
wb.Close SaveChanges:=False
Exit Sub
End If
If IsEmpty(checkValue) Or checkValue = "" Then
MsgBox "範囲外のコード列指定になっています。" & vbCrLf & _
"指定したコード列の2行目に値がありません。", vbExclamation
Application.ScreenUpdating = True ' MsgBox後に復元
wb.Close SaveChanges:=False
Exit Sub
End If
colLetter = UCase(txtDateCol.Text) ' 大文字に統一
' 日付列記号の妥当性チェック
If Not IsValidColumnLetter(colLetter) Then
MsgBox "日付列記号が無効です。" & vbCrLf & "A ? XFD の範囲で入力してください。", vbExclamation
Application.ScreenUpdating = True ' MsgBox後に復元
wb.Close SaveChanges:=False
Exit Sub
End If
colLetter = UCase(txtAmountCol.Text) ' 大文字に統一
' 金額列記号の妥当性チェック
If Not IsValidColumnLetter(colLetter) Then
MsgBox "金額列記号が無効です。" & vbCrLf & "A ? XFD の範囲で入力してください。", vbExclamation
Application.ScreenUpdating = True ' MsgBox後に復元
wb.Close SaveChanges:=False
Exit Sub
End If
Application.ScreenUpdating = True
' 実行
Call 集計処理(txtFile.Text, UCase(txtCodeCol.Text), UCase(txtDateCol.Text), UCase(txtAmountCol.Text))
End Sub
Private Sub btnClose_Click()
Application.WindowState = xlNormal
ThisWorkbook.Save
Application.Quit
End Sub
Function IsValidColumnLetter(colLetter As String) As Boolean
On Error GoTo ErrHandler
Dim rng As Range
Set rng = Worksheets(1).Range(colLetter & "1")
IsValidColumnLetter = True
Exit Function
ErrHandler:
IsValidColumnLetter = False
End Function

標準モジュール（Module1）

Option Explicit
Public Sub 集計処理(filePath As String, codeCol As String, dateCol As String, amountCol As String)
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim wb As Workbook
Dim ws As Worksheet
Dim lastRow As Long
Dim codeDict As Object: Set codeDict = CreateObject("Scripting.Dictionary")
Dim codeColNum As Long
Dim dateColNum As Long
Dim amountColNum As Long
Set wb = Workbooks.Open(filePath)
Set ws = wb.Sheets(1)
' 列番号取得
codeColNum = Range(codeCol & "1").Column
dateColNum = Range(dateCol & "1").Column
amountColNum = Range(amountCol & "1").Column
lastRow = ws.Cells(ws.Rows.Count, codeColNum).End(xlUp).row
' ソート
ws.Sort.SortFields.Clear
ws.Sort.SortFields.Add Key:=ws.Cells(2, codeColNum), Order:=xlAscending
ws.Sort.SortFields.Add Key:=ws.Cells(2, dateColNum), Order:=xlAscending
With ws.Sort
.SetRange ws.Range("A1", ws.Cells(lastRow, ws.Cells(1, Columns.Count).End(xlToLeft).Column))
.header = xlYes
.Apply
End With
' コードごとにデータ格納
Dim i As Long
For i = 2 To lastRow
Dim code As String, dt As String, amt As Double
code = Trim(ws.Cells(i, codeColNum).Value)
dt = Format(ws.Cells(i, dateColNum).Value, "yyyy/mm/dd")
amt = ws.Cells(i, amountColNum).Value
If code <> "" And dt <> "" And IsNumeric(amt) Then
If Not codeDict.exists(code) Then
codeDict.Add code, CreateObject("Scripting.Dictionary")
End If
With codeDict(code)
If .exists(dt) Then
.Item(dt) = .Item(dt) + amt
Else
.Add dt, amt
End If
End With
End If
Next i
' シート作成
Dim codeKey As Variant
For Each codeKey In codeDict.Keys
If シート存在チェック(wb, codeKey) Then
MsgBox "コード [" & codeKey & "] のシートはすでに存在します。処理を中止します。", vbInformation
wb.Close SaveChanges:=False
GoTo EndProc
End If
Dim newWS As Worksheet
Set newWS = wb.Sheets.Add(After:=wb.Sheets(wb.Sheets.Count))
newWS.Name = codeKey
' ヘッダー
newWS.Range("A1") = "日付"
newWS.Range("B1") = "合計金額"
' データ出力
Dim row As Long: row = 2
Dim dtKey As Variant
For Each dtKey In codeDict(codeKey).Keys
newWS.Cells(row, 1).Value = dtKey
newWS.Cells(row, 2).Value = codeDict(codeKey)(dtKey)
row = row + 1
Next dtKey
newWS.Cells.EntireColumn.AutoFit
Next codeKey
wb.Save
wb.Close SaveChanges:=True
Call 折れ線グラフを作成する(filePath)
MsgBox "集計&折れ線グラフ作成が完了しました", vbInformation
EndProc:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Private Function シート存在チェック(wb As Workbook, codeKey As Variant) As Boolean
Dim ws As Worksheet
For Each ws In wb.Sheets
If ws.Name = codeKey Then
シート存在チェック = True
Exit Function
End If
Next
シート存在チェック = False
End Function
Public Sub 折れ線グラフを作成する(filePath As String)
Dim wb As Workbook
Dim ws As Worksheet
Dim lastRow As Long
Dim chartObj As ChartObject
Dim chartRange As Range
Set wb = Workbooks.Open(filePath)
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each ws In wb.Worksheets
' 「集計元」シート（最初のシート）はスキップする（必要に応じて変更可能）
If ws.Index = 1 Then GoTo NextSheet
' 最終行の取得（A列を基準）
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).row
' データが2行以上あるか確認
If lastRow < 2 Then GoTo NextSheet
' グラフ範囲の指定（A列：日付、B列：合計金額）
Set chartRange = ws.Range("A1:B" & lastRow)
' グラフ作成
Set chartObj = ws.ChartObjects.Add(Left:=300, Top:=10, Width:=500, Height:=300)
With chartObj.Chart
.ChartType = xlLine
.SetSourceData Source:=chartRange
.HasTitle = True
.ChartTitle.Text = "日別売上推移"
.Axes(xlCategory).HasTitle = True
.Axes(xlCategory).AxisTitle.Text = "日付"
.Axes(xlValue).HasTitle = True
.Axes(xlValue).AxisTitle.Text = "合計金額"
.SeriesCollection(1).ApplyDataLabels
End With
NextSheet:
Next ws
wb.Save
wb.Close SaveChanges:=True
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

初心者向けマクロの作り方｜コードごとの自動集計シート作成【検証済】コードの使い方

以下手順で、シートごとにコード別日別集計＆折線グラフ作成するマクロは完成します。

フォームはコードがないので、ご自身で作成することになりますが、その他のコードは、【検証済】コードをコピペすればマクロができます。※フォーム作成方法も、下記で詳しく説明しますので、ご安心ください。

Excel起動からユーザーフォーム作成の操作

対象Excelファイル

ファイル選択

コード列（例：A）から終了まで

txtFile

btnBrowse

txtCodeCol

txtDateCol

txtAmountCol

btnAggregate

btnClose

【検証済】コードをコピペ

下記、ThisWorkbookモジュールをコピーします

Option Explicit
Private Sub Workbook_Open()
UserForm1.Show vbModeless
End Sub

下記、フォームのコードをコピーします

Option Explicit
Private Sub UserForm_Initialize()
' Excelウィンドウを最小化し、フォームを前面に出す
Application.WindowState = xlMinimized
Me.StartUpPosition = 1 ' 画面中央
Me.Show vbModeless
End Sub
Private Sub btnBrowse_Click()
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.Title = "Excelファイルを選択してください"
.Filters.Clear
.Filters.Add "Excelファイル", "*.xlsx; *.xlsm; *.xls"
If .Show = -1 Then
txtFile.Text = .SelectedItems(1)
End If
End With
End Sub
Private Sub btnAggregate_Click()
If txtFile.Text = "" Or txtCodeCol.Text = "" Or txtDateCol.Text = "" Or txtAmountCol.Text = "" Then
MsgBox "ファイルと各列をすべて指定してください", vbExclamation
Exit Sub
End If
If txtCodeCol.Text = txtDateCol.Text Then
MsgBox "コード列と日付列に同じ値は指定できません", vbExclamation
Exit Sub
End If
If txtCodeCol.Text = txtAmountCol.Text Then
MsgBox "コード列と金額列に同じ値は指定できません", vbExclamation
Exit Sub
End If
If txtDateCol.Text = txtAmountCol.Text Then
MsgBox "日付列と金額列に同じ値は指定できません", vbExclamation
Exit Sub
End If
Application.ScreenUpdating = False
Dim colLetter As String
colLetter = UCase(txtCodeCol.Text) ' 大文字に統一
' 列記号が正しいかと、2行目のセルに値があるか確認
Dim wb As Workbook
Set wb = Workbooks.Open(txtFile.Text)
Dim srcWs As Worksheet
Set srcWs = wb.Sheets(1) ' 最初のシートを対象に
Dim checkValue As Variant
On Error Resume Next
checkValue = srcWs.Range(colLetter & "2").Value
On Error GoTo 0
' コード列記号の妥当性チェック
If Not IsValidColumnLetter(colLetter) Then
MsgBox "コード列記号が無効です。" & vbCrLf & "A ? XFD の範囲で入力してください。", vbExclamation
Application.ScreenUpdating = True ' MsgBox後に復元
wb.Close SaveChanges:=False
Exit Sub
End If
If IsEmpty(checkValue) Or checkValue = "" Then
MsgBox "範囲外のコード列指定になっています。" & vbCrLf & _
"指定したコード列の2行目に値がありません。", vbExclamation
Application.ScreenUpdating = True ' MsgBox後に復元
wb.Close SaveChanges:=False
Exit Sub
End If
colLetter = UCase(txtDateCol.Text) ' 大文字に統一
' 日付列記号の妥当性チェック
If Not IsValidColumnLetter(colLetter) Then
MsgBox "日付列記号が無効です。" & vbCrLf & "A ? XFD の範囲で入力してください。", vbExclamation
Application.ScreenUpdating = True ' MsgBox後に復元
wb.Close SaveChanges:=False
Exit Sub
End If
colLetter = UCase(txtAmountCol.Text) ' 大文字に統一
' 金額列記号の妥当性チェック
If Not IsValidColumnLetter(colLetter) Then
MsgBox "金額列記号が無効です。" & vbCrLf & "A ? XFD の範囲で入力してください。", vbExclamation
Application.ScreenUpdating = True ' MsgBox後に復元
wb.Close SaveChanges:=False
Exit Sub
End If
Application.ScreenUpdating = True
' 実行
Call 集計処理(txtFile.Text, UCase(txtCodeCol.Text), UCase(txtDateCol.Text), UCase(txtAmountCol.Text))
End Sub
Private Sub btnClose_Click()
Application.WindowState = xlNormal
ThisWorkbook.Save
Application.Quit
End Sub
Function IsValidColumnLetter(colLetter As String) As Boolean
On Error GoTo ErrHandler
Dim rng As Range
Set rng = Worksheets(1).Range(colLetter & "1")
IsValidColumnLetter = True
Exit Function
ErrHandler:
IsValidColumnLetter = False
End Function

下記、標準モジュールをコピーします

Option Explicit
Public Sub 集計処理(filePath As String, codeCol As String, dateCol As String, amountCol As String)
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim wb As Workbook
Dim ws As Worksheet
Dim lastRow As Long
Dim codeDict As Object: Set codeDict = CreateObject("Scripting.Dictionary")
Dim codeColNum As Long
Dim dateColNum As Long
Dim amountColNum As Long
Set wb = Workbooks.Open(filePath)
Set ws = wb.Sheets(1)
' 列番号取得
codeColNum = Range(codeCol & "1").Column
dateColNum = Range(dateCol & "1").Column
amountColNum = Range(amountCol & "1").Column
lastRow = ws.Cells(ws.Rows.Count, codeColNum).End(xlUp).row
' ソート
ws.Sort.SortFields.Clear
ws.Sort.SortFields.Add Key:=ws.Cells(2, codeColNum), Order:=xlAscending
ws.Sort.SortFields.Add Key:=ws.Cells(2, dateColNum), Order:=xlAscending
With ws.Sort
.SetRange ws.Range("A1", ws.Cells(lastRow, ws.Cells(1, Columns.Count).End(xlToLeft).Column))
.header = xlYes
.Apply
End With
' コードごとにデータ格納
Dim i As Long
For i = 2 To lastRow
Dim code As String, dt As String, amt As Double
code = Trim(ws.Cells(i, codeColNum).Value)
dt = Format(ws.Cells(i, dateColNum).Value, "yyyy/mm/dd")
amt = ws.Cells(i, amountColNum).Value
If code <> "" And dt <> "" And IsNumeric(amt) Then
If Not codeDict.exists(code) Then
codeDict.Add code, CreateObject("Scripting.Dictionary")
End If
With codeDict(code)
If .exists(dt) Then
.Item(dt) = .Item(dt) + amt
Else
.Add dt, amt
End If
End With
End If
Next i
' シート作成
Dim codeKey As Variant
For Each codeKey In codeDict.Keys
If シート存在チェック(wb, codeKey) Then
MsgBox "コード [" & codeKey & "] のシートはすでに存在します。処理を中止します。", vbInformation
wb.Close SaveChanges:=False
GoTo EndProc
End If
Dim newWS As Worksheet
Set newWS = wb.Sheets.Add(After:=wb.Sheets(wb.Sheets.Count))
newWS.Name = codeKey
' ヘッダー
newWS.Range("A1") = "日付"
newWS.Range("B1") = "合計金額"
' データ出力
Dim row As Long: row = 2
Dim dtKey As Variant
For Each dtKey In codeDict(codeKey).Keys
newWS.Cells(row, 1).Value = dtKey
newWS.Cells(row, 2).Value = codeDict(codeKey)(dtKey)
row = row + 1
Next dtKey
newWS.Cells.EntireColumn.AutoFit
Next codeKey
wb.Save
wb.Close SaveChanges:=True
Call 折れ線グラフを作成する(filePath)
MsgBox "集計&折れ線グラフ作成が完了しました", vbInformation
EndProc:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Private Function シート存在チェック(wb As Workbook, codeKey As Variant) As Boolean
Dim ws As Worksheet
For Each ws In wb.Sheets
If ws.Name = codeKey Then
シート存在チェック = True
Exit Function
End If
Next
シート存在チェック = False
End Function
Public Sub 折れ線グラフを作成する(filePath As String)
Dim wb As Workbook
Dim ws As Worksheet
Dim lastRow As Long
Dim chartObj As ChartObject
Dim chartRange As Range
Set wb = Workbooks.Open(filePath)
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each ws In wb.Worksheets
' 「集計元」シート（最初のシート）はスキップする（必要に応じて変更可能）
If ws.Index = 1 Then GoTo NextSheet
' 最終行の取得（A列を基準）
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).row
' データが2行以上あるか確認
If lastRow < 2 Then GoTo NextSheet
' グラフ範囲の指定（A列：日付、B列：合計金額）
Set chartRange = ws.Range("A1:B" & lastRow)
' グラフ作成
Set chartObj = ws.ChartObjects.Add(Left:=300, Top:=10, Width:=500, Height:=300)
With chartObj.Chart
.ChartType = xlLine
.SetSourceData Source:=chartRange
.HasTitle = True
.ChartTitle.Text = "日別売上推移"
.Axes(xlCategory).HasTitle = True
.Axes(xlCategory).AxisTitle.Text = "日付"
.Axes(xlValue).HasTitle = True
.Axes(xlValue).AxisTitle.Text = "合計金額"
.SeriesCollection(1).ApplyDataLabels
End With
NextSheet:
Next ws
wb.Save
wb.Close SaveChanges:=True
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub