ここでは 週・月・年を同じグラフに重ねて比較する VBA 実務テンプレート をまとめました。これで「週別」「月別」「年別」の一致件数を 1つの折れ線グラフに重ねて比較 できます。
週・月・年を同じグラフに重ねて比較するテンプレート
Sub RangeToArray_NGWordCheck_WeeklyMonthlyYearlyChart()
Dim wsData As Worksheet, wsNG As Worksheet, wsReport As Worksheet
Dim rng As Range, arr As Variant, ngArr As Variant
Dim i As Long, j As Long, k As Long
Dim regEx As Object
Dim dictWeek As Object, dictMonth As Object, dictYear As Object
Dim chartObj As ChartObject
Dim logDate As Variant, weekKey As String, monthKey As String, yearKey As String
' シート指定
Set wsData = ThisWorkbook.Sheets("Sheet1")
Set wsNG = ThisWorkbook.Sheets("NGWords")
Set wsReport = ThisWorkbook.Sheets("Report")
' データ範囲（A列に日付、B〜C列にテキスト）
Set rng = wsData.Range("A2:C1000")
arr = rng.Value
' NGワードリスト
ngArr = wsNG.Range("A1", wsNG.Cells(wsNG.Rows.Count, "A").End(xlUp)).Value
' 正規表現
Set regEx = CreateObject("VBScript.RegExp")
regEx.IgnoreCase = True
regEx.Global = True
' 集計用 Dictionary
Set dictWeek = CreateObject("Scripting.Dictionary")
Set dictMonth = CreateObject("Scripting.Dictionary")
Set dictYear = CreateObject("Scripting.Dictionary")
' チェック処理＋週・月・年単位で集計
For i = LBound(arr, 1) To UBound(arr, 1)
logDate = arr(i, 1)
If IsDate(logDate) Then
weekKey = Format(logDate, "YYYY-ww") ' 年-週番号
monthKey = Format(logDate, "YYYY-MM") ' 年-月
yearKey = Format(logDate, "YYYY") ' 年
For j = 2 To UBound(arr, 2)
If VarType(arr(i, j)) = vbString Then
For k = LBound(ngArr, 1) To UBound(ngArr, 1)
regEx.Pattern = ngArr(k, 1)
If regEx.Test(arr(i, j)) Then
' 週単位
If Not dictWeek.Exists(weekKey) Then
dictWeek.Add weekKey, 1
Else
dictWeek(weekKey) = dictWeek(weekKey) + 1
End If
' 月単位
If Not dictMonth.Exists(monthKey) Then
dictMonth.Add monthKey, 1
Else
dictMonth(monthKey) = dictMonth(monthKey) + 1
End If
' 年単位
If Not dictYear.Exists(yearKey) Then
dictYear.Add yearKey, 1
Else
dictYear(yearKey) = dictYear(yearKey) + 1
End If
Exit For
End If
Next k
End If
Next j
End If
Next i
' レポート出力（週・月・年を並べる）
wsReport.Cells.Clear
wsReport.Range("A1:D1").Value = Array("Period", "WeeklyCount", "MonthlyCount", "YearlyCount")
Dim row As Long: row = 2
' 週単位出力
For Each k In dictWeek.Keys
wsReport.Cells(row, 1).Value = k
wsReport.Cells(row, 2).Value = dictWeek(k)
row = row + 1
Next k
' 月単位出力
For Each k In dictMonth.Keys
wsReport.Cells(row, 1).Value = k
wsReport.Cells(row, 3).Value = dictMonth(k)
row = row + 1
Next k
' 年単位出力
For Each k In dictYear.Keys
wsReport.Cells(row, 1).Value = k
wsReport.Cells(row, 4).Value = dictYear(k)
row = row + 1
Next k
' グラフ作成（週・月・年を重ねて比較）
wsReport.ChartObjects.Delete
Set chartObj = wsReport.ChartObjects.Add(Left:=250, Top:=50, Width:=650, Height:=350)
With chartObj.Chart
.ChartType = xlLineMarkers
.SetSourceData Source:=wsReport.Range("A1:D" & row - 1)
.HasTitle = True
.ChartTitle.Text = "週・月・年単位 NGワード一致件数比較"
.Axes(xlCategory).AxisTitle.Text = "Period"
.Axes(xlValue).AxisTitle.Text = "Count"
.SeriesCollection(1).Name = "Weekly"
.SeriesCollection(2).Name = "Monthly"
.SeriesCollection(3).Name = "Yearly"
End With
End Sub
ポイント
- 週 (YYYY-ww)、月 (YYYY-MM)、年 (YYYY) を同時に集計
- Report シートに「WeeklyCount」「MonthlyCount」「YearlyCount」を並べて出力
- 折れ線グラフ (xlLineMarkers) に 3 系列を重ねて比較
- 系列名を「Weekly」「Monthly」「Yearly」に設定して見やすく
実務応用例
- 週次・月次・年次監査の比較レポート
- 短期トレンド（週）・中期トレンド（月）・長期トレンド（年） の同時可視化
- コンプライアンス監査で「問題発生件数の推移」を多角的に把握
👉 このテンプレを使えば「週・月・年を同じグラフに重ねて比較」でき、監査レポートや定例報告に即活用できます。
さらに応用すると「週・月・年を同じグラフに重ねて 棒グラフ＋折れ線の複合グラフ」にすることも可能です。