ExcelVBAで積み上げ縦棒グラフを描く

0. はじめに

前回記事『Pythonで積み上げ縦棒グラフを描く』ではPythonを用いて積み上げ縦棒グラフを作り上げた。
今回はExcelVBAで前回記事ともうほぼほぼ同じグラフを作っていきたいと思う。

1. 目標を立てる

1.1. 存在するデータ

約1万5千人がプレイしているゲームの全ユーザーのデータがある。
このゲームでは各ユーザーは東西南北軍のいずれかの軍団に属している。
また各ユーザーはその行動タイプがA～Dの4種のいずれかに分類される。

ID	group	typeB	typeC	typeD	pt
00001	1	0	0	0	6.86
00002	1	0	0	1	7.65
00003	1	0	0	0	6.37
00004	1	1	0	0	8.19
00005	1	0	1	0	4.74
以下略

「group」列は所属軍団を表し、1から4までの数字が入っている。
「type」列は行動タイプを表し、AからDまでのいずれかが入っているが、ダミー変数化されている。
「pt」列は今回は使わない。

1.2. やりたいこと

各軍団毎の行動タイプ構成比および総数を視覚的に比較したい。
おそらく積み上げ棒グラフを作ると良いんじゃかろうか。

2. データ準備

2.1. データ読み込み

CSVファイルをExcelシートに展開する。
ここでは以前の記事で作成したユーザー定義関数read_csv()を使う。

Dim df As ListObject

Set df = read_csv("D:/data/file.csv")

2.2. データ整形

ダミー変数化された「type」列を一つにする。

With df.ListColumns.Add
    .Name = "type"
    .DataBodyRange.Formula = "=[@typeB]+[@typeC]*2+[@typeD]*3"
End With

type0～3が行動タイプABCDを表す列ができた。

諸事情によりついでに日本語化する。
いまtype列の各セルには数式が入っているので、.Value = .Value技で値に変換したのちに、.Replaceで置換を行う。でないと数式の一部が置換される（Excelあるある）。

With df.ListColumns("type")
    .DataBodyRange.Value = .DataBodyRange.Value
    .DataBodyRange.Replace 0, "タイプA"
    .DataBodyRange.Replace 1, "タイプB"
    .DataBodyRange.Replace 2, "タイプC"
    .DataBodyRange.Replace 3, "タイプD"
    .Name = "タイプ"
End With
With df.ListColumns("group")
    .DataBodyRange.Replace 1, "北軍"
    .DataBodyRange.Replace 2, "東軍"
    .DataBodyRange.Replace 3, "南軍"
    .DataBodyRange.Replace 4, "西軍"
    .Name = "軍団"
End With

2.3. グラフ用テーブル作成

軍団ごとの各行動タイプ別ユーザー数が知りたい。
ここでは、テーブル（ListObject型）・行になる列名（String型・配列でも可）・列になる列名（String型・配列でも可）を投げるとピボットテーブル機能を用いてクロス集計を行ってくれるcrosstab()関数を作った。

Function crosstab(ByVal data As ListObject, _
                  ByVal index As Variant, _
                  ByVal columns As Variant, _
                  Optional ByVal margins As Boolean = False) As PivotTable
    If TypeName(index) = "String" Then
        index = Array(index)
    End If
    If TypeName(columns) = "String" Then
        columns = Array(columns)
    End If

    Set crosstab = ActiveWorkbook.PivotCaches.Add( _
        xlDatabase, data).CreatePivotTable(Worksheets.Add.Range("A3"))

    With crosstab
        .AddDataField .PivotFields(index(0)), Function:=xlCount
        .AddFields index, columns
        .ColumnGrand = margins
        .RowGrand = margins
    End With
End Function

Dim ct As PivotTable

Set ct = crosstab(df, "軍団", "タイプ")

インデックス（軍団）の順番が気に食わないので修正。

ct.PivotFields("軍団").PivotItems("北軍").Position = 1
ct.PivotFields("軍団").PivotItems("東軍").Position = 2
ct.PivotFields("軍団").PivotItems("南軍").Position = 3
ct.PivotFields("軍団").PivotItems("西軍").Position = 4

タイプ	タイプA	タイプB	タイプC	タイプD
軍団
北軍	1843	724	922	249
東軍	1996	1035	862	796
南軍	759	440	570	1272
西軍	1107	390	417	270

こんなテーブルができました。

3. グラフ描画

結構大変だった。

まず、グラフを置きたいシートでShapes.AddChart2()を用いてグラフの型枠を作る。積み上げ棒グラフを作るのでXlChartType=xlColumnStackedを指定。第一引数Style=の数字の意味はよくわからないが、積み上げ棒グラフは297にするらしい（本当に意味がわからなかったら-1にしとくのが良い）。

Dim r As Range
Dim fig As Shape

' グラフの配置範囲
Set r = ActiveSheet.Range("B2:H17")

Set fig = ActiveSheet.Shapes.AddChart2( _
    297, xlColumnStacked, r.Left, r.Top, r.Width, r.Height)

Shapeの中のChartがグラフ本体らしい。

まずChart.SetSourceData()でグラフのデータを設定。PivotTableをデータにしたい場合はPivotTable.TableRange1でOK。
ついでにグラフタイトルを設定。

With fig.Chart
    .SetSourceData ct.TableRange1

    .HasTitle = True
    .ChartTitle.Text = "ユーザー構成"
End With

x軸ラベルとy軸ラベルを設定。Excelは軸の名前がわかりにくい。
ついでにy軸と平行に方眼線（ExcelではMajorGridlineというらしい）を引く。

With fig.Chart
    ' x軸
    With .Axes(xlCategory)
        .HasTitle = True
        .AxisTitle.Characters.Text = "軍団"
    End With

    ' y軸
    With .Axes(xlValue)
        .HasTitle = True
        .AxisTitle.Characters.Text = "ユーザー数"

        ' 方眼線
        .HasMajorGridlines = True
        .MajorGridlines.Border.Color = RGB(220, 220, 220)
    End With
End With

つづいて棒グラフの色と網掛けを系列ごとにひとつひとつ指定。
色指定に関して事前にカラーマップを作成した。

Dim cmap As Variant: cmap = Array( _
    RGB(31, 119, 180), RGB(255, 127, 14), RGB(44, 160, 44), _
    RGB(214, 39, 40), RGB(148, 103, 189), RGB(140, 86, 75), _
    RGB(227, 119, 194), RGB(127, 127, 127), RGB(188, 189, 34), _
    RGB(23, 190, 207), RGB(30, 30, 30))

With fig.Chart
    With .SeriesCollection(1).Format.Fill
        .ForeColor.RGB = cmap(0)
    End With
    With .SeriesCollection(2).Format.Fill
        .Patterned msoPatternWideUpwardDiagonal
        .ForeColor.RGB = cmap(10)
        .BackColor.RGB = cmap(1)
    End With
    With .SeriesCollection(3).Format.Fill
        .Patterned msoPattern10Percent
        .ForeColor.RGB = cmap(10)
        .BackColor.RGB = cmap(2)
    End With
    With .SeriesCollection(4).Format.Fill
        .Patterned msoPatternDarkHorizontal
        .ForeColor.RGB = cmap(10)
        .BackColor.RGB = cmap(3)
    End With
End With

凡例をグラフの右側に表示。

With fig.Chart
    .HasLegend = True
    .Legend.Position = xlLegendPositionRight
End With

完成したので保存。

fig.Chart.Export "D:/data/bar.png"

できた。

4. おわり

できた。