はじめに
Excelのグラフに第3軸を追加したいときがあります。
前回二つのグラフを重ねることで折れ線グラフを棒グラフの後ろにもってくる方法を紹介しました。
touch-sp.hatenablog.com
同じテクニックで今回は第3軸を追加する方法を紹介します。
元のデータ
今回は例としてこのようなデータを使用することにします。
普通にグラフを描くと左のようになると思います。
方法
次のような二つのグラフを描いてそれらを重ね合わせて完成です。
- まずはExcelシートを以下のように拡張します
左側のグラフを描くときには「A」と「B」は同じ軸(左側の軸)を使いますので「A」の値を10倍する必要があります。
右側のグラフは縦軸の最大値を60に設定して「100」という数字をプロットしています。「100」という数字はグラフ表示可能な範囲外ですので軸だけ残ります。「100」でなくても「60」より大きければなんでも構いません。
- あとは次のVBAコード(マクロ)を実行するだけです。
Dim my_data As Range Set my_data = Range("A6:D9") Dim my_data2 As Range Set my_data2 = Range("A11") ActiveSheet.Shapes.AddChart2(332, xlLineMarkers).Select ActiveChart.SetSourceData Source:=my_data With ActiveChart .Parent.Name = "chart1" .ChartTitle.Delete .HasLegend = msoTrue .Legend.Position = xlLegendPositionBottom .FullSeriesCollection(3).AxisGroup = 2 .Axes(xlValue).MinimumScale = 0 .Axes(xlValue).MaximumScale = 600 .Axes(xlValue).MajorUnit = 100 .Axes(xlValue).Format.Line.Visible = msoTrue .Axes(xlValue).Format.Line.ForeColor.RGB = RGB(0, 0, 0) .Axes(xlValue).MajorTickMark = xlOutside .Axes(xlValue, xlSecondary).MinimumScale = 0 .Axes(xlValue, xlSecondary).MaximumScale = 6000 .Axes(xlValue, xlSecondary).MajorUnit = 1000 .Axes(xlValue, xlSecondary).Format.Line.Visible = msoTrue .Axes(xlValue, xlSecondary).Format.Line.ForeColor.RGB = RGB(0, 0, 0) .Axes(xlValue, xlSecondary).MajorTickMark = xlOutside .ChartArea.Format.Line.Visible = msoTrue .ChartArea.Format.Line.ForeColor.RGB = RGB(0, 0, 0) End With ActiveSheet.Shapes.AddChart2(332, xlLineMarkers).Select ActiveChart.SetSourceData Source:=my_data2 With ActiveChart .Parent.Name = "chart2" .ChartTitle.Delete .HasLegend = msoFalse .Axes(xlValue).MinimumScale = 0 .Axes(xlValue).MaximumScale = 60 .Axes(xlValue).MajorUnit = 10 .Axes(xlValue).Format.Line.Visible = msoTrue .Axes(xlValue).Format.Line.ForeColor.RGB = RGB(0, 0, 0) .Axes(xlValue).MajorTickMark = xlOutside .Axes(xlValue).MajorGridlines.Delete .Axes(xlCategory).Delete .ChartArea.Format.Fill.Visible = msoFalse .ChartArea.Format.Line.Visible = msoFalse End With Dim chart1_w As Integer Dim chart1_h As Integer Dim chart1_l As Integer Dim chart1_t As Integer Dim chart2_w As Integer Dim chart2_h As Integer Dim chart2_l As Integer Dim chart2_t As Integer With ActiveSheet.ChartObjects("chart1").Chart.PlotArea chart1_w = CInt(.InsideWidth) chart1_h = CInt(.InsideHeight) chart1_l = CInt(.InsideLeft) chart1_t = CInt(.InsideTop) End With With ActiveSheet.ChartObjects("chart2").Chart.PlotArea chart2_l = CInt(.InsideLeft) End With ActiveSheet.ChartObjects("chart1").Chart.PlotArea.InsideTop = chart1_t ActiveSheet.ChartObjects("chart2").Chart.PlotArea.InsideTop = chart1_t ActiveSheet.ChartObjects("chart1").Chart.PlotArea.InsideHeight = chart1_h ActiveSheet.ChartObjects("chart2").Chart.PlotArea.InsideHeight = chart1_h ActiveSheet.ChartObjects("chart1").Chart.PlotArea.InsideWidth = chart1_w - chart2_l - 5 ActiveSheet.ChartObjects("chart1").Chart.PlotArea.InsideLeft = chart1_l + chart2_l + 5 ActiveSheet.ChartObjects("chart1").Select ActiveSheet.ChartObjects("chart2").Select Replace:=msoFalse Selection.Group Range("A1").Select
結果
冒頭にも示したこのような図が描けます。
コードの解説
コードは3部構成になっています。
- 下に来るグラフを作成する
- 上に来るグラフを作成する
- 二つのグラフのプロットエリア内側を統一させる
グラフ作成のコードを実行すると次の二つのグラフが出来ます。
この部分はほとんどが前回記事と重複するためここでは省略させてもらいます。
二つのグラフが描けたら次にプロットエリアの調整を行います。(実際にコード内で調整するのはプロットエリア内側です)
まずは二つのグラフのプロットエリアの縦位置と高さを揃えます。
ActiveSheet.ChartObjects("chart1").Chart.PlotArea.InsideTop = chart1_t ActiveSheet.ChartObjects("chart2").Chart.PlotArea.InsideTop = chart1_t ActiveSheet.ChartObjects("chart1").Chart.PlotArea.InsideHeight = chart1_h ActiveSheet.ChartObjects("chart2").Chart.PlotArea.InsideHeight = chart1_h
次に一つ目のグラフのプロットエリアを軸が入るスペース分右に縮めます。
ActiveSheet.ChartObjects("chart1").Chart.PlotArea.InsideWidth = chart1_w - chart2_l - 5 ActiveSheet.ChartObjects("chart1").Chart.PlotArea.InsideLeft = chart1_l + chart2_l + 5
右に縮める場合には先にプロットエリアの幅を小さく設定しておく必要があります。それをしないで縮めようとすると(左端を右方向にずらすと)ただプロットエリアが右に移動するだけで右端がチャートエリアを超えることになりうまくいきません。
また、ここで出てくる「5」という数字はその都度設定するパラメーターです。大きくすれば軸と軸のスペースが広くなります。
ここまで来たら後はグループ化して終了です。
ActiveSheet.ChartObjects("chart1").Select ActiveSheet.ChartObjects("chart2").Select Replace:=msoFalse Selection.Group
二つのグラフの位置は最初から重なっているはずなので調整は不要です。
動作環境
以下の環境で作成しています。
Windows 10 Office Home and Business 2019
【2020年12月19日追記】
ほかにも同様のテクニックでできることを記事にしました。もしよかったら読んで下さい。
touch-sp.hatenablog.com