ここでは 週単位と月単位の一致件数を同じグラフに重ねて比較する VBA 実務テンプレート をまとめました。これで「週別推移」と「月別推移」を 1つのグラフに重ねて比較 できます。
週・月を同じグラフに重ねて比較するテンプレート
Sub RangeToArray_NGWordCheck_WeeklyMonthlyChart()
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, dictWeek As Object, dictMonth As Object
Dim chartObj As ChartObject
Dim logDate As Variant, weekKey As String, monthKey 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")
' チェック処理＋週・月単位で集計
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") ' 年-月
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
Exit For
End If
Next k
End If
Next j
End If
Next i
' レポート出力（週・月を並べる）
wsReport.Cells.Clear
wsReport.Range("A1:C1").Value = Array("Period", "WeeklyCount", "MonthlyCount")
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
' グラフ作成（週と月を重ねて比較）
wsReport.ChartObjects.Delete
Set chartObj = wsReport.ChartObjects.Add(Left:=250, Top:=50, Width:=600, Height:=350)
With chartObj.Chart
.ChartType = xlLineMarkers
.SetSourceData Source:=wsReport.Range("A1:C" & 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"
End With
End Sub
ポイント
- 週単位 (YYYY-ww) と 月単位 (YYYY-MM) を同時に集計
- Report シートに「WeeklyCount」「MonthlyCount」を並べて出力
- 折れ線グラフ (xlLineMarkers) に両方の系列を重ねて比較
- 系列名を「Weekly」「Monthly」に設定して見やすく
実務応用例
- 週次監査 vs 月次監査 の比較レポート
- 短期トレンド（週）と長期トレンド（月） の同時可視化
- コンプライアンス監査で「週ごとの波」と「月ごとの傾向」を一目で把握
👉 このテンプレを使えば「週・月を同じグラフに重ねて比較」でき、監査レポートや定例報告に即活用できます。
さらに応用すると「週・月・年を同じグラフに重ねる」ことも可能です。