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

Excelマクロ

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

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

を作ってきた。

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

Microsoft Excel 2019の利用を想定しています。

サンプル

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

 

 今回のマクロ「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」に代入する。

Set (変数) = Worksheets(i).Shapes.AddChart2(XlChartType:=(グラフの種類))
⇒ i番目のワークシートに種類を指定してグラフを追加し、追加したグラフを変数に代入する。

 

 次に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」の値をグラフタイトルに代入する。

(変数).Top = Worksheets(1).セル範囲.Top
⇒ 変数に格納した図(グラフ)の上位置を選択したセル範囲の上位置に合わせる。

(変数).Left = Worksheets(1).セル範囲.Left
⇒ 変数に格納した図(グラフ)の左位置を選択したセル範囲の左位置に合わせる。

(変数).Width = Worksheets(1).セル範囲.Width
⇒ 変数に格納した図(グラフ)の幅を選択したセル範囲の幅に合わせる。

(変数).Chart.ChartTitle.Text = (グラフタイトル)
⇒ 変数に格納したグラフのタイトルを指定する。

 

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

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の値を代入する。
 以上の処理を、ワークシートの数だけ繰り返す。

(変数).Chart.SeriesCollection.NewSeries
⇒ 変数に格納したグラフに新しいデータ系列を追加する。

(変数).Chart.SeriesCollection(i).Name = (凡例の名前)
⇒ 変数に格納したグラフのi番目のデータ系列の名前(凡例)を指定する。

(変数).Chart.SeriesCollection(i).XValues = Worksheets(j).セル範囲
⇒ 変数に格納したグラフのi番目のデータ系列の横軸の値に、j番目のワークシートの指定したセル範囲の値を代入する。

(変数).Chart.SeriesCollection(i).Values = Worksheets(j).セル範囲
⇒ 変数に格納したグラフのi番目のデータ系列の縦軸の値に、j番目のワークシートの指定したセル範囲の値を代入する。

 

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

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

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

(変数).Chart.Axes(xlCategory).MinimumScale = (値)
⇒ 変数に格納したグラフの横軸の最小値を指定する。

(変数).Chart.Axes(xlCategory).MaximumScale = (値)
⇒ 変数に格納したグラフの横軸の最大値を指定する。

(変数).Chart.Axes(xlCategory, xlPrimary).HasTitle = True
⇒ 変数に格納したグラフに横軸ラベルを表示させる。

(変数).Chart.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = (横軸ラベル)
⇒ 変数に格納したグラフの横軸ラベルに指定したテキストを代入する。

(変数).Chart.Axes(xlValue, xlPrimary).HasTitle = True
⇒ 変数に格納したグラフに縦軸ラベルを表示させる。

(変数).Chart.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = (縦軸ラベル)
⇒ 変数に格納したグラフの縦軸ラベルに指定したテキストを代入する。

(変数).Chart.SetElement (msoElementLegendRight)
⇒ 変数に格納したグラフの凡例をグラフ内の右側に表示させる。

グラフ削除

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

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

コメント

タイトルとURLをコピーしました