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

　以前、データの取り込みとグラフ化を自動で実施するマクロを作成した。

以前、複数のデータファイルを1つのExcelファイルに集約させるマクロや、　必要なデータのみを抽出し、1つのシートにまとめて表示させるマクロを作ってきた。　今回は時系列データなどを取り込んで、グラフを描画するマクロを作ったので紹介する...

　ただこのマクロではグラフ化するデータの横軸のデータ数が固定されており、横軸のデータ数が異なるデータを合わせてグラフ化することができなかった。

　例えば、2つのデータがあり、両方とも横軸の範囲は0～10だが、片方は横軸のピッチ1でデータ数が11、もう片方はピッチ2でデータ数が6だったとする。

　このとき両者とも横軸の範囲は同一だが、横軸のデータ数が異なるため、上記マクロでは同時にグラフ化できなかった。

　今回は上記の弱点を克服し、任意の横軸のデータ数でグラフ描画を可能にしたマクロを作成した。

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

サンプル
コード詳説
終わりに

サンプル

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

Excel_Macro_Sample_9.zip ↓

　サンプルの使い方は前回の使い方と大差ない。

　が、今回の改良に伴って横軸のデータ数が異なる複数のデータファイルを同時にグラフ化することが可能となった。

　また横軸の最大値、最小値もマクロ内で探索できるようになったため、最大、最小値の設定セルが不要となった。

　また、本サンプルでグラフ化を実施するデータファイルは下記条件を満たす必要がある。

・横軸のデータ数が5個以上
・データの1列目に横軸の情報が記載されている

　上記条件を満たさないデータは、取り込みは可能だがグラフ化まではできないので注意。

コード詳説

　「exp9_cpmp_xlsm」も前回と同様5つのマクロが保存されている。

　今回は「グラフ作成」マクロの追加・変更部分のみを解説するため、その他のコードについては以前アップした記事を参照されたい。

　「グラフ作成」マクロの中身は下記のようになっている。

Sub グラフ作成()
    Dim GraphA As Shape
    Dim GraphB As Shape
    Dim i As Long
    Dim j As Long
    Dim Wmin As Variant
    Dim Wmax As Variant
    Dim Wmini As Variant
    Dim Wmaxi As Variant
    
    
    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
        
        j = 1
        Do Until IsNumeric(Worksheets(i).Cells(j, 1)) = True And Worksheets(i).Cells(j, 1).Value <> "" _
             And IsNumeric(Worksheets(i).Cells(j + 1, 1)) = True And Worksheets(i).Cells(j + 1, 1).Value <> "" _
             And IsNumeric(Worksheets(i).Cells(j + 2, 1)) = True And Worksheets(i).Cells(j + 2, 1).Value <> "" _
             And IsNumeric(Worksheets(i).Cells(j + 3, 1)) = True And Worksheets(i).Cells(j + 3, 1).Value <> "" _
             And IsNumeric(Worksheets(i).Cells(j + 4, 1)) = True And Worksheets(i).Cells(j + 4, 1).Value <> ""
             
             j = j + 1
             
        Loop
    
        With GraphA.Chart
            .SeriesCollection.NewSeries
            .SeriesCollection(i - 1).Name = Worksheets(1).Cells(i + 6, 3).Value
            .SeriesCollection(i - 1).XValues = Worksheets(i).Range(Worksheets(i).Cells(j, 1), Worksheets(i).Cells(j, 1).End(xlDown))
            .SeriesCollection(i - 1).Values = Worksheets(i).Range(Worksheets(i).Cells(j, 2), Worksheets(i).Cells(j, 2).End(xlDown))
        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(Worksheets(i).Cells(j, 1), Worksheets(i).Cells(j, 1).End(xlDown))
            .SeriesCollection(i - 1).Values = Worksheets(i).Range(Worksheets(i).Cells(j, 3), Worksheets(i).Cells(j, 3).End(xlDown))
        End With
        
        
        Wmaxi = WorksheetFunction.Max(Worksheets(i).Range(Worksheets(i).Cells(j, 1), Worksheets(i).Cells(j, 1).End(xlDown)))
        If Wmaxi <> Int(Wmaxi) Then
            Wmaxi = Int(Wmaxi) + 1
        End If
        
        If i = 2 Then
            Wmax = Wmaxi
        ElseIf Wmax < Wmaxi Then
            Wmax = Wmaxi
        End If
        
        
        Wmini = Int(WorksheetFunction.Min(Worksheets(i).Range(Worksheets(i).Cells(j, 1), Worksheets(i).Cells(j, 1).End(xlDown))))
        
        If i = 2 Then
            Wmin = Wmini
        ElseIf Wmin > Wmini Then
            Wmin = Wmini
        End If
        
    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 = Wmin
         .Axes(xlCategory).MaximumScale = Wmax
         .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 = Wmin
         .Axes(xlCategory).MaximumScale = Wmax
         .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

　今回は前回からの追加・変更部分のみを解説し、前回と被る部分については解説を省略する。

　前回と被る部分については下記記事を参照されたい。

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

　最初の追加コードは、データをグラフに取り込むコード群のはじめ「For i=2 To Worksheets.Count」の次にある

j = 1
Do Until IsNumeric(Worksheets(i).Cells(j, 1)) = True And Worksheets(i).Cells(j, 1).Value <> "" _
     And IsNumeric(Worksheets(i).Cells(j + 1, 1)) = True And Worksheets(i).Cells(j + 1, 1).Value <> "" _
     And IsNumeric(Worksheets(i).Cells(j + 2, 1)) = True And Worksheets(i).Cells(j + 2, 1).Value <> "" _
     And IsNumeric(Worksheets(i).Cells(j + 3, 1)) = True And Worksheets(i).Cells(j + 3, 1).Value <> "" _
     And IsNumeric(Worksheets(i).Cells(j + 4, 1)) = True And Worksheets(i).Cells(j + 4, 1).Value <> ""
             
j = j + 1
             
Loop

である。

　これは「1列目に数値セルが初めて5つ連続したとき、その最初のセルを横軸データの出発点とする」という条件のもとで横軸データの開始場所を探索するコードである。

　1列目の5つのセルCells(j,1),Cells(j+1,1),Cells(j+2,1),Cells(j+3,1),Cells(j+4,1)のセル値の種類を調べ、どれか1つが数値以外、もしくは空白だった場合は、jに1をプラスして再び同様の処理を繰り返す。

　具体的には、j=1の場合はセルA1,A2,A3,A4,A5のセル値の種類を調べ、上記条件を満たせばj=2となって、セルA2,A3,A4,A5,A6のセル値の種類を調べる、といった形だ。

　この処理を続け、あるところで5つのセル値すべてが空白でない数値になったときに処理が終了する。

　このときのセルCells(j,1)が、横軸データの出発点となる。

　次に、グラフの横軸データと縦軸データの取り込みをするコードを以下のように書き直した。

.SeriesCollection(i - 1).XValues = Worksheets(i).Range(Worksheets(i).Cells(j, 1), Worksheets(i).Cells(j, 1).End(xlDown))
.SeriesCollection(i - 1).Values = Worksheets(i).Range(Worksheets(i).Cells(j, 2), Worksheets(i).Cells(j, 2).End(xlDown))

　当初はRangeの中が固定領域であり、データ上でデータ数と書き込み位置を固定させる必要があったが、Cellsを使って終端セルまで選択させるコードを導入して選択領域に柔軟性を持たせた。

　実はこの終端セルを使う方法は前回に導入しようとしたのだが、どうしてもうまくマクロが走ってくれず断念した経緯がある。

　当初はRangeの中のCellsに対してWorksheetsを指定していなかった(Rangeに対してすでにWorksheetsを指定しているため)。

　しかしワークシートを複数跨ぐマクロの場合は、Rangeの中のCellsに対しても逐一Worksheetsを指定する必要があるようで、指定したところ期待通りの動きをしてくれた。

　続いて、横軸の最小値と最大値を指定するコードを追加した。

Wmaxi = WorksheetFunction.Max(Worksheets(i).Range(Worksheets(i).Cells(j, 1), Worksheets(i).Cells(j, 1).End(xlDown)))

If Wmaxi <> Int(Wmaxi) Then
     Wmaxi = Int(Wmaxi) + 1
End If
        
If i = 2 Then
     Wmax = Wmaxi
ElseIf Wmax < Wmaxi Then
     Wmax = Wmaxi
End If
        
        
Wmini = Int(WorksheetFunction.Min(Worksheets(i).Range(Worksheets(i).Cells(j, 1), Worksheets(i).Cells(j, 1).End(xlDown))))
        
If i = 2 Then
     Wmin = Wmini
ElseIf Wmin > Wmini Then
     Wmin = Wmini
End If

　最大値に関しては、まずi番目のワークシートでの最大値をWmaxiに代入する。

　次にWmaxiが整数値でない場合は、Wmaxiの整数部分に1を足した整数値を新たにWmaxiに代入する。

　続いてi=2のときはWmaxにWmaxiをそのまま代入し、それ以降はWmaxiがWmaxを上回った時だけ、WmaxにWmaxiを代入する。

これを全ワークシートで繰り返して最大値を更新していく。

最小値についても、基本的には最大値の場合と更新方法は同じである。

終わりに

　データファイルのフォーマットに関する条件はつくが、グラフの横軸のデータ数に囚われずグラフ化するマクロを作成できた。

　これで、横軸の領域は同じでもデータ数が異なる複数のデータファイルをグラフ化できる。

　データファイルのフォーマットの制限は致し方ない部分もあるかもしれないが、なるべく「このマクロに通せば万事解決」という理想のマクロ作成を意識していこうと思う。

　END