エラー種別ごとに系列を分けた複数折れ線グラフを作成するVBAサンプルです。
日付ごとに「エラー種別別の件数」を集計し、各種別を1本の折れ線として描画します。
サンプルコード
Sub ErrorTrendByType()
Dim wsSrc As Worksheet, wsDst As Worksheet
Dim lastRow As Long, i As Long
Dim dict As Object, dictType As Object
Dim dt As Variant, errType As String
Dim chartObj As ChartObject
Dim r As Long, c As Long
' チェック結果シート（A列=日付, C列=エラー種別）
Set wsSrc = Sheets("チェック結果")
lastRow = wsSrc.Cells(wsSrc.Rows.Count, 1).End(xlUp).Row
' 集計用シート準備
On Error Resume Next
Set wsDst = Sheets("エラー推移種別")
If wsDst Is Nothing Then
Set wsDst = Sheets.Add
wsDst.Name = "エラー推移種別"
Else
wsDst.Cells.Clear
End If
On Error GoTo 0
' Dictionary(日付ごと)の中にDictionary(種別ごと)を格納
Set dict = CreateObject("Scripting.Dictionary")
For i = 2 To lastRow
If IsDate(wsSrc.Cells(i, 1).Value) And wsSrc.Cells(i, 3).Value <> "" Then
dt = CDate(wsSrc.Cells(i, 1).Value)
errType = CStr(wsSrc.Cells(i, 3).Value)
If Not dict.exists(dt) Then
Set dictType = CreateObject("Scripting.Dictionary")
dict.Add dt, dictType
End If
If dict(dt).exists(errType) Then
dict(dt)(errType) = dict(dt)(errType) + 1
Else
dict(dt).Add errType, 1
End If
End If
Next i
' ユニークなエラー種別一覧を作成
Dim allTypes As Object
Set allTypes = CreateObject("Scripting.Dictionary")
For Each dt In dict.keys
For Each errType In dict(dt).keys
If Not allTypes.exists(errType) Then allTypes.Add errType, True
Next
Next
' 見出し行出力
wsDst.Cells(1, 1).Value = "日付"
c = 2
For Each errType In allTypes.keys
wsDst.Cells(1, c).Value = errType
c = c + 1
Next
' データ出力（日付昇順）
Dim sortedDates() As Variant
sortedDates = dict.keys
Call QuickSortDates(sortedDates, LBound(sortedDates), UBound(sortedDates))
r = 2
For i = LBound(sortedDates) To UBound(sortedDates)
wsDst.Cells(r, 1).Value = sortedDates(i)
c = 2
For Each errType In allTypes.keys
If dict(sortedDates(i)).exists(errType) Then
wsDst.Cells(r, c).Value = dict(sortedDates(i))(errType)
Else
wsDst.Cells(r, c).Value = 0
End If
c = c + 1
Next
r = r + 1
Next
' グラフ作成
Set chartObj = wsDst.ChartObjects.Add(Left:=250, Top:=50, Width:=500, Height:=300)
With chartObj.Chart
.ChartType = xlLineMarkers
.SetSourceData Source:=wsDst.Range("A1").CurrentRegion
.HasTitle = True
.ChartTitle.Text = "エラー種別ごとの件数推移"
.Axes(xlCategory).HasTitle = True
.Axes(xlCategory).AxisTitle.Text = "日付"
.Axes(xlValue).HasTitle = True
.Axes(xlValue).AxisTitle.Text = "件数"
End With
MsgBox "エラー種別ごとの折れ線グラフを作成しました。"
End Sub
' 日付配列を昇順ソートする簡易クイックソート
Sub QuickSortDates(arr As Variant, ByVal first As Long, ByVal last As Long)
Dim low As Long, high As Long
Dim mid As Variant, tmp As Variant
low = first: high = last
mid = arr((first + last) \ 2)
Do While low <= high
Do While arr(low) < mid: low = low + 1: Loop
Do While arr(high) > mid: high = high - 1: Loop
If low <= high Then
tmp = arr(low): arr(low) = arr(high): arr(high) = tmp
low = low + 1: high = high - 1
End If
Loop
If first < high Then QuickSortDates arr, first, high
If low < last Then QuickSortDates arr, low, last
End Sub
✅ 処理の流れ
- 「チェック結果」シートから日付とエラー種別を読み込み
- 日付×種別の件数をDictionaryで集計
- 「エラー推移種別」シートにクロス集計表を出力
- 行：日付
- 列：エラー種別
- 値：件数
- 折れ線グラフを作成し、各種別を系列として描画
💡 応用ポイント
- 系列ごとに色や線スタイルを変更して見やすくする
- 月単位や週単位に集計して長期トレンドを分析
- 件数が多い種別だけを抽出してグラフ化する
👉 このマクロを使えば、エラー種別ごとの発生傾向を一目で比較できる折れ線グラフを自動生成できます。
