Excel VBA 逆引き集 | グラフの自動作成

Excel VBA
スポンサーリンク

グラフの自動作成

「毎回のグラフ作りをボタンひとつで終わらせたい」——基本から応用まで、使い回せるテンプレをまとめました。棒・折れ線・円、複数系列、テーブル連動、カテゴリごとに量産、レイアウト・書式の自動調整まで、初心者でも壊れない形で説明します。

最短テンプレ：範囲からグラフを作る

Sub CreateBarChart_Basic()
    'A1:B10のデータを棒グラフ化
    Dim ws As Worksheet: Set ws = ActiveSheet
    Dim ch As ChartObject
    Set ch = ws.ChartObjects.Add(Left:=100, Top:=60, Width:=400, Height:=300)

    With ch.Chart
        .ChartType = xlColumnClustered     '棒グラフ
        .SetSourceData Source:=ws.Range("A1:B10")
        .HasTitle = True
        .ChartTitle.Text = "売上データ"
        .Axes(xlValue).HasTitle = True
        .Axes(xlValue).AxisTitle.Text = "金額"
        .Axes(xlCategory).HasTitle = True
        .Axes(xlCategory).AxisTitle.Text = "カテゴリ"
    End With
End Sub
VB
  • ポイント: ChartObjects.Addで領域を作り、ChartTypeとSetSourceDataを指定すれば最短で完成。タイトルや軸ラベルは最初に一緒に設定すると毎回整う。

種類別テンプレ：折れ線・円・複合

Sub CreateLineChart()
    Dim ws As Worksheet: Set ws = ActiveSheet
    Dim ch As ChartObject: Set ch = ws.ChartObjects.Add(120, 60, 420, 280)
    With ch.Chart
        .ChartType = xlLine            '折れ線
        .SetSourceData ws.Range("A1:C13")  '日付×複数系列など
        .HasTitle = True
        .ChartTitle.Text = "月次推移"
        .Axes(xlCategory).CategoryType = xlCategoryScale
    End With
End Sub

Sub CreatePieChart()
    Dim ws As Worksheet: Set ws = ActiveSheet
    Dim ch As ChartObject: Set ch = ws.ChartObjects.Add(560, 60, 320, 320)
    With ch.Chart
        .ChartType = xlPie             '円グラフ
        .SetSourceData ws.Range("A1:B6")
        .HasLegend = True
        .HasTitle = True
        .ChartTitle.Text = "構成比"
    End With
End Sub

Sub CreateComboChart_BarLine()
    '棒＋折れ線の複合（第2軸使用）
    Dim ws As Worksheet: Set ws = ActiveSheet
    Dim ch As ChartObject: Set ch = ws.ChartObjects.Add(100, 380, 520, 320)
    With ch.Chart
        .SetSourceData ws.Range("A1:C13") 'A=カテゴリ/日付, B=数量(棒), C=単価(線)
        .ChartType = xlColumnClustered
        .HasTitle = True
        .ChartTitle.Text = "数量と単価"
        '2系列目を折れ線＋第2軸
        .SeriesCollection(2).ChartType = xlLine
        .SeriesCollection(2).AxisGroup = xlSecondary
        .Axes(xlValue, xlSecondary).HasTitle = True
        .Axes(xlValue, xlSecondary).AxisTitle.Text = "単価"
    End With
End Sub
VB
  • ポイント: ChartTypeを変えるだけで主な種類は作れる。複合はSeriesCollectionで系列ごとにタイプ・軸を切り替える。

元データをテーブル化して自動拡張に対応

Sub CreateChart_FromTable()
    'データをテーブル化→行追加でも自動追従
    Dim ws As Worksheet: Set ws = Worksheets("データ")
    Dim lo As ListObject
    On Error Resume Next
    Set lo = ws.ListObjects(1)
    On Error GoTo 0
    If lo Is Nothing Then
        Set lo = ws.ListObjects.Add(xlSrcRange, ws.Range("A1").CurrentRegion, , xlYes)
        lo.Name = "売上テーブル"
    End If

    Dim ch As ChartObject
    Set ch = ws.ChartObjects.Add(Left:=100, Top:=60, Width:=420, Height:=300)
    With ch.Chart
        .ChartType = xlColumnClustered
        .SetSourceData Source:=ws.Range(lo.Name) 'テーブル名で参照
        .HasTitle = True
        .ChartTitle.Text = "テーブル連動グラフ"
    End With
End Sub
VB
  • ポイント: テーブル化しておくと行が増えても範囲再指定不要。グラフ更新はデータ変更後の再計算で自動反映されやすい。

カテゴリごとにグラフを量産（支店別など）

Sub CreateCharts_ByCategory()
    'Sheet1: A=支店名, B=売上。支店ごとに棒グラフを縦に並べて生成
    Dim ws As Worksheet: Set ws = Worksheets("Sheet1")
    Dim last As Long: last = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    '支店名のユニーク収集
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    Dim r As Long
    For r = 2 To last
        If Len(ws.Cells(r, "A").Value) > 0 Then dict(ws.Cells(r, "A").Value) = True
    Next

    '縦に配置
    Dim posTop As Long: posTop = 60
    Dim key As Variant
    For Each key In dict.Keys
        '対象支店のデータ範囲抽出（簡易フィルタなしの直描画）
        '実用では抽出用の一時範囲を作るか、系列にXValues/Valuesを個別設定
        Dim ch As ChartObject
        Set ch = ws.ChartObjects.Add(Left:=60, Top:=posTop, Width:=420, Height:=260)
        With ch.Chart
            .ChartType = xlColumnClustered
            .HasTitle = True
            .ChartTitle.Text = "支店別売上 - " & CStr(key)
            '系列を手動設定（X軸：行番号、Y軸：支店一致の値）
            .SeriesCollection.NewSeries
            .SeriesCollection(1).Name = CStr(key)
            .SeriesCollection(1).XValues = ws.Range("B1:B" & last) '凡例用の見出し・軸は適宜調整
            .SeriesCollection(1).Values = ws.Evaluate("IF(A2:A" & last & "=""" & key & """,B2:B" & last & ",NA())")
        End With
        posTop = posTop + 280
    Next
End Sub
VB
  • ポイント: ユニークカテゴリごとにグラフを自動生成し、配置位置をずらす。記事の例のように縦並び・命名・削除再作成などの運用で量産が楽になる。

レイアウト・書式の自動整形

  • サイズ・位置を統一:
    • 例: ChartObjects.AddのLeft/Top/Width/Heightを定数にする。複数グラフは行列配置ロジックで並べる。
  • 凡例・データラベル:
    • 例: .HasLegend = True、.SeriesCollection(i).ApplyDataLabels。円グラフは割合表示を追加。
  • 色・線・軸のカスタム:
    • 例: .SeriesCollection(1).Format.Fill.ForeColor.RGB = RGB(79,129,189)、.Axes(xlValue).MinimumScale = 0。
  • タイトル・軸ラベルの共通化:
    • 例: .ChartTitle.Text = "月次売上", .Axes(xlCategory).AxisTitle.Text = "月" 。

ボタンで一括作成・更新

Sub BuildAllCharts()
    Application.ScreenUpdating = False
    '既存グラフ削除（必要なら）
    Dim ws As Worksheet: Set ws = ActiveSheet
    Dim i As Long
    For i = ws.ChartObjects.Count To 1 Step -1
        ws.ChartObjects(i).Delete
    Next
    'テンプレ呼び出し
    Call CreateBarChart_Basic
    Call CreateLineChart
    Call CreatePieChart
    'カテゴリ量産など
    'Call CreateCharts_ByCategory
    Application.ScreenUpdating = True
End Sub
VB
  • ポイント: 既存グラフを掃除してからテンプレ群を呼べば、レポートを毎回同じレイアウトで再生成できる。

よくある落とし穴と対策

  • ラベルと数値の列が逆で意図しない軸になる
    • 対策: SetSourceDataで見出し行を含む縦2列（カテゴリ・値）を渡す。必要に応じてSeriesCollectionでXValues/Valuesを明示。
  • 元データの行追加で範囲が切れる
    • 対策: テーブル化してテーブル名で参照。グラフは範囲拡張に追随しやすい。
  • 凡例や系列名が空で見づらい
    • 対策: 見出し行を必ず含めるか、SeriesCollection(i).Nameで明示的に設定。
  • 大量のグラフでレイアウトが崩れる
    • 対策: 位置・サイズを関数化し、行列レイアウトで規則的に配置。必要なら1シート1カテゴリに分割。
  • 自動更新が欲しい
    • 対策: ボタンで再生成、またはWorksheet_Change/Workbook_Openで再ビルドを呼ぶ（更新頻度が高い場合は手動ボタン推奨）。

例題で練習

'例1：A1:B10を棒グラフで作る
Sub Example_Bar()
    Call CreateBarChart_Basic
End Sub

'例2：A1:C13の推移を折れ線で作る
Sub Example_Line()
    Call CreateLineChart
End Sub

'例3：A1:B6の構成比を円で作る
Sub Example_Pie()
    Call CreatePieChart
End Sub

'例4：テーブル連動のグラフ
Sub Example_Table()
    Call CreateChart_FromTable
End Sub

'例5：カテゴリ（支店）ごとにグラフ量産
Sub Example_ByCategory()
    Call CreateCharts_ByCategory
End Sub

'例6：ボタンで一括作成・更新
Sub Example_BuildAll()
    Call BuildAllCharts
End Sub
VB
スポンサーリンク
タイトルとURLをコピーしました