【Excelマクロ】取り込んだデータからグラフを描画

　以前、複数のデータファイルを1つのExcelファイルに集約させるマクロや、

　必要なデータのみを抽出し、1つのシートにまとめて表示させるマクロ

を作ってきた。

　今回は時系列データなどを取り込んで、グラフを描画するマクロを作ったので紹介する。

サンプル

　今回使うサンプルは下記ボタンから入手可能である。

　

　今回のマクロ「exp6_comp.xlsm」を開くと、Sheet1が下図のように表示される。

　「データファイル取得」のボタンを押してデータファイルを取得すると、下図のようにデータが転記されたシートが追加される。

　次に「グラフ作成」ボタンをクリックすると、転記されたデータからグラフを作成する。

　グラフのタイトルや軸ラベルなどは、グラフの上の表に文字列、値を入力して指定することが出来るようになっている。
　また各データの凡例はC列で指定可能。

　またこれまで作成したデータ抽出機能も備えており、「データ抽出および表示」ボタンを押せば以前と同様の使い方でデータの抽出と表示が可能である。

　「グラフ削除」ボタンでグラフのみを削除することが出来る。
　「データファイル転記シートおよびグラフの削除」ボタンでグラフ、転記シート等を全て削除し、初期状態に戻る。

コード詳説

　「exp6_comp.xlsm」には計5つのマクロが保存されている。

　本記事ではグラフの作成、削除に関するマクロの解説を実施し、その他のマクロについては以前書いた記事を参照されたい。

データファイルの取得

　下記記事を参照。

データ抽出および表示

　下記記事を参照。

グラフ作成

　マクロの中身は下記のようになっている。

Sub グラフ作成()
    Dim GraphA As Shape
    Dim GraphB As Shape
    Dim i As Long
    
    
    Set GraphA = Worksheets(1).Shapes.AddChart2(XlChartType:=xlXYScatterSmoothNoMarkers)
        With GraphA
         .Top = Worksheets(1).Range("H6:M6").Top
         .Left = Worksheets(1).Range("H6:M6").Left
         .Width = Worksheets(1).Range("H6:M6").Width
         .Chart.ChartTitle.Text = Worksheets(1).Range("H3").Value
        End With
        
    Set GraphB = Worksheets(1).Shapes.AddChart2(XlChartType:=xlXYScatterSmoothNoMarkers)
        With GraphB
         .Top = Worksheets(1).Range("H18:M18").Top
         .Left = Worksheets(1).Range("H18:M18").Left
         .Width = Worksheets(1).Range("H18:M18").Width
         .Chart.ChartTitle.Text = Worksheets(1).Range("I3").Value
        End With
    
    
    For i = 2 To Worksheets.Count
        With GraphA.Chart
            .SeriesCollection.NewSeries
            .SeriesCollection(i - 1).Name = Worksheets(1).Cells(i + 6, 3).Value
            .SeriesCollection(i - 1).XValues = Worksheets(i).Range("A3:A13")
            .SeriesCollection(i - 1).Values = Worksheets(i).Range("B3:B13")
        End With
        
        With GraphB.Chart
            .SeriesCollection.NewSeries
            .SeriesCollection(i - 1).Name = Worksheets(1).Cells(i + 6, 3).Value
            .SeriesCollection(i - 1).XValues = Worksheets(i).Range("A3:A13")
            .SeriesCollection(i - 1).Values = Worksheets(i).Range("C3:C13")
        End With
    Next
    
    
    i = Worksheets.Count
    Do While GraphA.Chart.SeriesCollection.Count <> Worksheets.Count - 1
        GraphA.Chart.FullSeriesCollection(i).Delete
    Loop
    
    i = Worksheets.Count
    Do While GraphB.Chart.SeriesCollection.Count <> Worksheets.Count - 1
        GraphB.Chart.FullSeriesCollection(i).Delete
    Loop
    
    
    With GraphA.Chart
         .Axes(xlCategory).MinimumScale = Worksheets(1).Range("M3").Value
         .Axes(xlCategory).MaximumScale = Worksheets(1).Range("N3").Value
         .Axes(xlCategory, xlPrimary).HasTitle = True
         .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = Worksheets(1).Range("L3").Value
         .Axes(xlValue, xlPrimary).HasTitle = True
         .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = Worksheets(1).Range("J3").Value
         .SetElement (msoElementLegendRight)
    End With
    
    
    With GraphB.Chart
         .Axes(xlCategory).MinimumScale = Worksheets(1).Range("M3").Value
         .Axes(xlCategory).MaximumScale = Worksheets(1).Range("N3").Value
         .Axes(xlCategory, xlPrimary).HasTitle = True
         .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = Worksheets(1).Range("L3").Value
         .Axes(xlValue, xlPrimary).HasTitle = True
         .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = Worksheets(1).Range("K3").Value
         .SetElement (msoElementLegendRight)
    End With

    
End Sub

　2つのグラフを作成しているが、使用コードは両者で変わらないので片方のグラフの作成コードのみ解説する。

　

　まずは

 Set GraphA = Worksheets(1).Shapes.AddChart2(XlChartType:=xlXYScatterSmoothNoMarkers)

でシート1にデータマーカーなしの平滑線付き散布図を追加し、追加したグラフを変数「GraphA」に代入する。

　

　次にGraphAの大きさと位置、グラフタイトルを指定する。

With GraphA
  .Top = Worksheets(1).Range("H6:M6").Top
  .Left = Worksheets(1).Range("H6:M6").Left
  .Width = Worksheets(1).Range("H6:M6").Width
  .Chart.ChartTitle.Text = Worksheets(1).Range("H3").Value
End With

　それぞれ、グラフの上位置、左位置、幅をセル範囲「H6:M6」の上位置、左位置、幅に合わせ、セル「H3」の値をグラフタイトルに代入する。

　

　次に、設置したグラフにデータを読み込ませる。

For i = 2 To Worksheets.Count
  With GraphA.Chart
    .SeriesCollection.NewSeries
    .SeriesCollection(i - 1).Name = Worksheets(1).Cells(i + 6, 3).Value
    .SeriesCollection(i - 1).XValues = Worksheets(i).Range("A3:A13")
    .SeriesCollection(i - 1).Values = Worksheets(i).Range("B3:B13")
  End With
Next

　まず変数iに2を代入し、GrraphAに新しいデータ系列を追加する。
　次に、新しく追加したi-1番目(i=2の場合は1番目)のデータ系列の名前(凡例)に、1番目のワークシートのi+6行3列目のセルの値を指定する。
　続いてi-1番目のデータ系列の横軸の値にi番目のワークシートのセルA3からセルA13の値を、縦軸の値にi番目のワークシートのセルB3からセルB13の値を代入する。
　以上の処理を、ワークシートの数だけ繰り返す。

　

　次に、グラフに追加したデータ系列の数が実際のデータ数よりも多い場合に、余計なデータ系列を削除する。

i = Worksheets.Count
  Do While GraphA.Chart.SeriesCollection.Count <> Worksheets.Count - 1
    GraphA.Chart.FullSeriesCollection(i).Delete
  Loop

　まず変数iにワークシートの数を代入する。
　次に、GraphAのi番目のデータ系列を削除する。
　これをGraphAのデータ系列の数が、ワークシートの数と同じになるまで繰り返す。

　一番最初にグラフを作る際は問題ないが、グラフの作り直しをすると前に追加したデータ系列が残ってしまうため、これを削除するのがこのコードの目的である。

　

　最後に、グラフの細かい部分の設定をする。

With GraphA.Chart
  .Axes(xlCategory).MinimumScale = Worksheets(1).Range("M3").Value
  .Axes(xlCategory).MaximumScale = Worksheets(1).Range("N3").Value
  .Axes(xlCategory, xlPrimary).HasTitle = True
  .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = Worksheets(1).Range("L3").Value
  .Axes(xlValue, xlPrimary).HasTitle = True
  .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = Worksheets(1).Range("J3").Value
  .SetElement (msoElementLegendRight)
End With

　ここでは横軸の最大値と最小値、横軸と縦軸のラベルを指定し、凡例を表示させている。

グラフ削除

　マクロの中身は下記のようになっている。

Sub グラフ削除()
    Dim shp As Shape
    
    For Each shp In Worksheets(1).Shapes
    If shp.Type = msoChart Then
    shp.Delete
    End If
    Next
End Sub

　基本は、変数「shp」に代入した図形が「msoChart」、すなわちグラフの場合はそれを削除する。
　そして上記の処理を、1番目のワークシート内の図形を1つずつ変数「shp」に代入した上で、その図形の数だけ繰り返す。

データファイル転記シートおよびグラフの削除

　グラフ削除のコードは前節を参照。

　その他のコードについては下記を参照。

終わりに

　ボタン1つでグラフを作成できるマクロを書き上げることができたが、正直この現状にはまだ満足していない。

　このマクロではグラフ化するデータ領域が固定されており、その領域が変化するとマクロ自体を書き直す必要がある。

　次はこのデータ領域の変化に対応できるマクロを作ろうとしているが、なかなかうまくいっていない。

　もしうまく作れたら公開しようと思う。

　

　END