グラフもVBAで自動作成できる
先日、ある層の社員に対するアンケート結果をグラフにする仕事がありました。
アンケートは対象の社員が仕事や日常生活に対してどのように考えているのかを把握する目的で作られており、各個人ごとのアンケート結果を面談時の資料にするのですが、限られた時間で多くの社員の状況を把握できるようにレーダーチャートを作ってほしいとの要望です。
対象となる社員の数が多い（約100人）ため、手作業でグラフを作るのが大変だったので、VBAを使用してグラフを作成する方法を考えました。
今回はその時に勉強して作った複数のレーダーチャートを一括で作成するExcelVBAを紹介します。
種類の指定→サイズの指定→タイトルや凡例の設定→範囲の設定の順序でグラフ作成
グラフの作成はいくつかのステップで構成されていて、マクロの記録で作成したVBAコードは順序がバラバラに記録作成されるため解読しにくいです。
今回レーダーチャートを作成するにあたっては下記の手順で作成することにします。
グラフを作成する際、範囲をあらかじめ設定してから作成しても良いのですが、たくさんのグラフを一括で作成する場合、余計な部分が多くなるのでまず対象範囲を空に戻して必要なグラフ範囲のみ設定することにしています。
スポンサーリンク
グラフを作成する対象シート
今回グラフを作成する際に使用する表は下記のようなものです。
アンケートは対象者1名につき2回実施しており、それぞれの実施回において平均点も算出しています。
レーダーチャートは対象者1人ごとに1個作成するので、2回分の結果とそれぞれの平均も載せるように作成します。
レーダーチャートを連続作成するExcelVBA
今回作成したレーダーチャートを一括作成するExcelVBAのコードは下記の通りです。
少しずつ位置をずらしながら繰り返してグラフを作成する仕様になっております。
Dim グラフ
i = 1
Do Until Cells(i + 2, 2) = “”
Set グラフ = ActiveSheet.Shapes.AddChart2(317, xlRadar) ’マーカーなしレーダーグラフ
With グラフ ’グラフ位置の設定
.Top = Range(Rows(1), Rows(2)).Height + Range(Rows(3), Rows(7)).Height * (i － 1)
.Left = Range(Columns(1), Columns(14)).Width
.Width = Range(Columns(15), Columns(19)).Width
.Height = Range(Rows(3), Rows(7)).Height － 1.5
With .Chart
.HasTitle = True ’タイトルを表示する
.ChartTitle.Text = Cells(i + 2, 1) & ” ” & Cells(i + 2, 2)
.HasLegend = True ’凡例を表示する
.Legend.Position = xlLegendPositionRight ’凡例を右に表示する
.Axes(xlValue).MajorUnit = 1 ’グラフの主目盛を設定する
Do Until .SeriesCollection.Count = 0 ’自動でグラフ範囲設定される場合があるので削除しておく
.SeriesCollection(1).Delete
Loop
.SeriesCollection.NewSeries ’系列（1回目）の追加
With .FullSeriesCollection(1)
.Name = “=Sheet1!” & Cells(2, 1).Address
.Values = “=Sheet1!” & Range(Cells(i + 2, 3), Cells(i + 2, 9)).Address
.XValues = “=Sheet1!” & Range(Cells(2, 3), Cells(2, 9)).Address ’レーダーチャートの項目軸設定
.Border.Color = RGB(0, 0, 255)
End With
.SeriesCollection.NewSeries ’系列（2回目）の追加
With .FullSeriesCollection(2)
.Name = “=Sheet1!” & Cells(10, 1).Address
.Values = “=Sheet1!” & Range(Cells(i + 10, 3), Cells(i + 10, 9)).Address
.Border.Color = RGB(255, 0, 0)
End With
.SeriesCollection.NewSeries ’系列（平均1回目）の追加
With .FullSeriesCollection(3)
.Name = “平均” & Cells(2, 1)
.Values = “=Sheet1!” & Range(Cells(8, 3), Cells(8, 9)).Address
.Border.LineStyle = xlDot ’点線
.Border.Weight = xlHairline ’極細
.Border.Color = RGB(50, 50, 255)
End With
.SeriesCollection.NewSeries ’系列（平均2回目）の追加
With .FullSeriesCollection(4)
.Name = “平均” & Cells(10, 1)
.Values = “=Sheet1!” & Range(Cells(16, 3), Cells(16, 9)).Address
.Border.LineStyle = xlDot
.Border.Weight = xlHairline
.Border.Color = RGB(255, 50, 50)
End With
End With
End With
Set グラフ = Nothing
i = i + 1
Loop
End Sub
値の参照位置は式で「=Sheet1!$C$3:$I$3」などのような記載方法しかないので、変数部分はアドレス関数を用いて変換しています。
他のグラフの作成手順はまた別の機会にご紹介します。
コメント