以前、データの取り込みとグラフ化を自動で実施するマクロを作成した。
ただこのマクロではグラフ化するデータの横軸のデータ数が固定されており、横軸のデータ数が異なるデータを合わせてグラフ化することができなかった。
例えば、2つのデータがあり、両方とも横軸の範囲は0~10だが、片方は横軸のピッチ1でデータ数が11、もう片方はピッチ2でデータ数が6だったとする。
このとき両者とも横軸の範囲は同一だが、横軸のデータ数が異なるため、上記マクロでは同時にグラフ化できなかった。
今回は上記の弱点を克服し、任意の横軸のデータ数でグラフ描画を可能にしたマクロを作成した。
サンプル
今回使うサンプルは下記ボタンから入手可能である。
サンプルの使い方は前回の使い方と大差ない。
が、今回の改良に伴って横軸のデータ数が異なる複数のデータファイルを同時にグラフ化することが可能となった。
また横軸の最大値、最小値もマクロ内で探索できるようになったため、最大、最小値の設定セルが不要となった。
また、本サンプルでグラフ化を実施するデータファイルは下記条件を満たす必要がある。
・横軸のデータ数が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
今回は前回からの追加・変更部分のみを解説し、前回と被る部分については解説を省略する。
前回と被る部分については下記記事を参照されたい。
最初の追加コードは、データをグラフに取り込むコード群のはじめ「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
コメント