Excel VBA | Range→配列→加工→高速書戻し の実務テンプレ

VBA
スポンサーリンク

「一致件数をグラフ化する」ための VBA 実務テンプレートをまとめました。これで NGワードごとの一致件数を棒グラフ化 できます。


一致件数をグラフ化するテンプレート

Sub RangeToArray_NGWordCheck_Graph()

    Dim wsData As Worksheet
    Dim wsNG As Worksheet
    Dim wsReport As Worksheet
    Dim rng As Range
    Dim arr As Variant
    Dim ngArr As Variant
    Dim i As Long, j As Long, k As Long
    Dim regEx As Object
    Dim dict As Object
    Dim chartObj As ChartObject
    
    ' シート指定
    Set wsData = ThisWorkbook.Sheets("Sheet1")
    Set wsNG = ThisWorkbook.Sheets("NGWords")
    Set wsReport = ThisWorkbook.Sheets("Report")
    
    ' データ範囲
    Set rng = wsData.Range("A1: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 dict = CreateObject("Scripting.Dictionary")
    
    ' チェック処理+集計
    For i = LBound(arr, 1) To UBound(arr, 1)
        For j = LBound(arr, 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
                        rng.Cells(i, j).Interior.Color = vbRed
                        rng.Cells(i, j).Font.Bold = True
                        
                        ' 集計カウント
                        If Not dict.Exists(ngArr(k, 1)) Then
                            dict.Add ngArr(k, 1), 1
                        Else
                            dict(ngArr(k, 1)) = dict(ngArr(k, 1)) + 1
                        End If
                        
                        Exit For
                    End If
                Next k
            End If
        Next j
    Next i
    
    ' レポート出力
    wsReport.Cells.Clear
    wsReport.Range("A1:B1").Value = Array("NGWord", "Count")
    Dim row As Long: row = 2
    For Each k In dict.Keys
        wsReport.Cells(row, 1).Value = k
        wsReport.Cells(row, 2).Value = dict(k)
        row = row + 1
    Next k
    
    ' グラフ作成
    wsReport.ChartObjects.Delete ' 古いグラフ削除
    Set chartObj = wsReport.ChartObjects.Add(Left:=250, Top:=50, Width:=400, Height:=300)
    With chartObj.Chart
        .ChartType = xlColumnClustered
        .SetSourceData Source:=wsReport.Range("A1:B" & row - 1)
        .HasTitle = True
        .ChartTitle.Text = "NGワード一致件数"
        .Axes(xlCategory).HasTitle = True
        .Axes(xlCategory).AxisTitle.Text = "NGWord"
        .Axes(xlValue).HasTitle = True
        .Axes(xlValue).AxisTitle.Text = "Count"
    End With
    
    ' 書戻し
    rng.Value = arr

End Sub
VB

ポイント

  • Dictionary で NGワードごとの一致件数を集計
  • Report シートに一覧化
  • 棒グラフ (xlColumnClustered) を自動生成
  • グラフタイトル・軸ラベルも自動設定

実務応用例

  • NGワード監査レポートを グラフ付きで提出
  • 一致件数の推移を 視覚的に把握
  • 複数回実行して 比較レポート を作成

👉 このテンプレを使えば「NGワードチェック → 集計 → グラフ化」まで一気に自動化できます。
さらに応用すると「日付ごとの一致件数を折れ線グラフ化」や「複数シートの結果をまとめてグラフ化」も可能です。

VBA
スポンサーリンク
シェアする
@lifehackerをフォローする
スポンサーリンク
タイトルとURLをコピーしました