Excelのグラフに3軸目を追加したい。そうだ二つのグラフを重ねることにしよう。【VBA使用】

はじめに

Excelのグラフに第3軸を追加したいときがあります。

f:id:touch-sp:20201218003831p:plain:w500
こんなグラフを描きたい

前回二つのグラフを重ねることで折れ線グラフを棒グラフの後ろにもってくる方法を紹介しました。
touch-sp.hatenablog.com
同じテクニックで今回は第3軸を追加する方法を紹介します。

元のデータ

今回は例としてこのようなデータを使用することにします。
f:id:touch-sp:20201218004351p:plain:w400

普通にグラフを描くと左のようになると思います。
f:id:touch-sp:20201218010951p:plain:w500

方法

次のような二つのグラフを描いてそれらを重ね合わせて完成です。
f:id:touch-sp:20201218005245p:plain

  • まずはExcelシートを以下のように拡張します

f:id:touch-sp:20201218011703p:plain:w600
左側のグラフを描くときには「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

結果

冒頭にも示したこのような図が描けます。
f:id:touch-sp:20201218003831p:plain:w500

コードの解説

コードは3部構成になっています。

  • 下に来るグラフを作成する
  • 上に来るグラフを作成する
  • 二つのグラフのプロットエリア内側を統一させる


グラフ作成のコードを実行すると次の二つのグラフが出来ます。
f:id:touch-sp:20201219000410p:plain
この部分はほとんどが前回記事と重複するためここでは省略させてもらいます。

二つのグラフが描けたら次にプロットエリアの調整を行います。(実際にコード内で調整するのはプロットエリア内側です)

まずは二つのグラフのプロットエリアの縦位置と高さを揃えます。
f:id:touch-sp:20201219002654p:plain:w600

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


次に一つ目のグラフのプロットエリアを軸が入るスペース分右に縮めます。
f:id:touch-sp:20201219001323p:plain:w300

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

このエントリーをはてなブックマークに追加