【本日のミッション】
Excel VBAにて、系列が1つのグラフを元に、データ範囲を変更したグラフを大量連続作成せよ。
目次
ミッションの概要
複数系列のグラフはコチラ→系列が複数あるグラフを自動大量連続作成（Excel VBA）
現実的に意味のないグラフになっていますが、サンプルということでご了承ください。
今回は下記データを使わせていただき、グラフにしやすい表に加工しました。
今回のミッションは、この表の年毎のグラフを作りましょう！というものです。
・
・
私は大量のグラフを作成するときは、
- 元になるグラフを1つ作る。
- そのグラフをコピーして参照先を変更するVBAを作成する。
という手順にしています。
今回は2002年のグラフを「グラフ 元」という名前にして、あらかじめ作成しておきます。
グラフをVBAで一から作ると。コードが複雑になります。
それを一つ一つ作り上げるのに時間がかかりますし、VBAの処理時間も長くなってしまいます。
これが最終フォーマット！というグラフを一つだけきっちり作り上げて、それをコピーして参照先を変更・・・
という流れにしておけば、グラフのフォーマットが変更になっても、一つのグラフだけ修正して、VBAを再度処理すれば修正時間も短くて済みます。
■スポンサーリンク
ファイルの準備とプロシージャ
表と元グラフを準備し（下記参照）、そのシートをアクティブにした状態で、Alt＋F11でVsual Basic Editerを起動します。
［挿入］－［標準モジュール］で新規モジュールを作成し、下記の通りコードを記入します。
Sub グラフを大量作成()
'【変数】
'グラフ関連
Dim cht_m As Chart '元グラフ
Dim cht As Chart '処理対象グラフ
Dim fml1 As String '系列名・タイトル用セル範囲
Dim fml2 As String '軸ラベル用セル範囲
Dim fml3 As String '系列値用セル範囲
Dim c_ct As Long 'グラフカウント（前回グラフ削除）
Dim c_no As Long 'グラフ番号
'行列関連
Dim t_row_d As Long '対象データ行
Dim t_row_c As Long 'グラフ貼付行
Application.ScreenUpdating = False
'■変数セット
Set cht_m = ActiveSheet.ChartObjects("グラフ 元").Chart '元グラフ
t_row_d = 8 '対象データ行（2003年開始行）
t_row_c = 14 'グラフ貼付行（2003年開始行）
c_no = 2 'グラフ番号
'■前回作成グラフを削除
For c_ct = ActiveSheet.ChartObjects.Count To 1 Step -1
'□元グラフ（グラフ 元）以外削除
If ActiveSheet.ChartObjects(c_ct).Name <> "グラフ 元" Then
ActiveSheet.ChartObjects(c_ct).Delete
End If
Next c_ct
'■表の2003年から順に処理
Do While Cells(t_row_d, 1) <> "" '表のデータが空欄になったら終了
'□グラフのコピー
cht_m.ChartArea.Copy '元グラフをコピー
Cells(t_row_c, 6).Select 'グラフ貼付セル選択
ActiveSheet.Paste 'グラフ貼付
Set cht = ActiveChart '変数cht=処理対象グラフ
cht.Parent.Name = "グラフ " & c_no 'グラフ名前変更
c_no = c_no + 1
'□グラフ参照変更
fml1 = Cells(t_row_d, 1).Address(External:=True) '系列名・タイトル用セル
fml2 = Range(Cells(t_row_d, 2), Cells(t_row_d + 3, 2)).Address(External:=True) '軸ラベル用セル
fml3 = Range(Cells(t_row_d, 3), Cells(t_row_d + 3, 3)).Address(External:=True) '系列値用セル
cht.ChartTitle.Formula = "=" & fml1 'グラフタイトル変更
cht.SeriesCollection(1).Formula = "=Series(" & fml1 & "," & fml2 & "," & fml3 & ",1)" 'グラフデータ参照先変更
t_row_d = t_row_d + 4 '対象データ行+4（次年行）
t_row_c = t_row_c + 10 'グラフ貼付行 （次年グラフ貼付行）
Loop
Application.ScreenUpdating = True
End Sub
記入したモジュールのどこかにカーソルを置いてF5キーをクリックしてください。
Excelのシートに、2003年（グラフ 2）～2020年（グラフ 19）が出来上がります。
・
・
■スポンサーリンク
おおまかなVBA処理の流れ
- 前回作成のグラフが存在する場合（2回目以降の修正処理を考慮）、元グラフの「グラフ 元」以外削除しておく。
- 表データを上から順に処理を行い、表データがなくなった時点で処理を終了する。
表データは4行ごとの処理とする。 - 元グラフ「グラフ 元」をコピーする。
グラフのコピー行は10行おきとする。 - グラフの名前を変更する。「グラフ 2」から番号＋1としていく。
- グラフタイトル参照先を変更する。
- グラフデータ参照先を変更する。
何度でも修正を繰り返すことができるVBAにしておく
こういうデータは、フォーマットの変更の可能性が高いので、何度でも繰り返し修正処理ができるようにしておきます。
下記処理は、名前が「グラフ 元」以外のグラフを削除する内容です。
「グラフ 元」はコピー元グラフとして使用するので削除しません。
'■前回作成グラフを削除
For c_ct = ActiveSheet.ChartObjects.Count To 1 Step -1
'□元グラフ（グラフ 元）以外削除
If ActiveSheet.ChartObjects(c_ct).Name <> "グラフ 元" Then
ActiveSheet.ChartObjects(c_ct).Delete
End If
Next c_ctアクティブシートに存在するグラフ全てについて、グラフ名が「グラフ 元」でなければ削除すればいいのですが、処理の順番に注意が必要です。
IF判定で、グラフが削除された時点で、アクティブシート全体のグラフの個数が変わります。
もし処理の順番が「1つ目のグラフ」→「アクティブシートの全グラフの個数」だとしたら・・・↓↓↓
For c_ct =1 To ActiveSheet.ChartObjects.Count処理開始時は「ActiveSheet.ChartObjects.Count＝19」だったとして、途中でグラフが1個削除されたら・・・「ActiveSheet.ChartObjects.Count＝18」になってしまいます。
そんな処理が繰り返されるので、グラフは一つおきに削除され、最後にはエラーが出て止まってしまいます。
そうならないように削除処理を行うときは「Step -1」を使って、「アクティブシートの全グラフの個数」→「1つ目のグラフ」という順番にします。
参考：ワークシート内のグラフを「グラフ 元」以外全て削除（Excel VBA）
元グラフの準備
元グラフは丁寧に作ります。
VBAを一通り処理した後、全てのグラフを確認し、必要であれば最大値や最小値の数値(統一する場合)、項目軸の位置の調整（全てのグラフで正しく表示されるように）などを行い、再度VBA処理を行います。
今回のグラフの参照先は、下記の通りです。
グラフのタイトルも、セル参照にしています。
元グラフの名前は「グラフ 元」にしておきます。
（初期値の「グラフ 1」のままだと、ChartObjects.Nameが「Chart 1」になることがあるので、私は「グラフ 元」という名前にしています。）
元グラフを選択し、[ホーム]－[編集]－[検索と選択]ー[オブジェクトの選択と表示]で名前を変更します。
処理行の変更
次年のグラフ作成処理に移行する際、
表データの行番号：「＋4」
グラフ貼付行：「＋10」
としています。
【処理開始時の数値】 t_row_d = 8 '対象データ行（2003年開始行） t_row_c = 14 'グラフ貼付行（2003年開始行）
【次年のグラフ作成処理に移行する際の数値変更】 t_row_d = t_row_d + 4 '対象データ行+4（次年行） t_row_c = t_row_c + 10 'グラフ貼付行 （次年グラフ貼付行）
Do While Loopを抜けるタイミング
データの処理順は、上記「■処理行の変更」の通りですが、いつまでも永遠に続けるわけではありません。
t_row_d = t_row_d + 4 '対象データ行+4（次年行）
を続けていくと、いつか「t_row_d＝80」になる瞬間が訪れます。
そこです！！！
Do While Cells(t_row_d, 1) <> "" '表のデータが空欄になったら終了Cells(t_row_d, 1)はセルA80です。
セルA80が空欄だと判断されて、Do While Loopを抜け、次の処理へ移ります。
グラフコピー
昔、ActiveSheet.ChartObjects(n).Copyで大量にグラフコピー処理をすると、すごく時間がかかって、ActiveSheet.ChartObjects(n).Chart.ChartArea.Copy で処理すると時短になったことがあって、それ以来「ChartArea」を使っていたんです。
でも、今改めて2つのコードで処理時間を比較してみたら、あんまり違いが無かったんです。PCの環境が昔と違うからかなぁ・・・。
とりあえず、今回は「ChartArea」を使ったコードにしています。
グラフ参照先を変えるとグラフの色が変わってしまう現象
Excelにはありがた迷惑な機能があります。
グラフの参照先を変えると、自動的にグラフの色が変わってしまうことがあります。
「規定の元の色に戻しておきましたよ～」と言わんばかりに。
この現象が起こった時は下記設定を変更し、再度マクロ処理を行います。
［ファイル］－［オプション］
［詳細設定］ー［グラフ］
「グラフのデータ要素の参照先が現在のブックに設定されているプロパティ」のチェックを外します。
これにチェックが付いていると、参照先を変更するたびにブックに設定されているグラフのデータ要素に戻されてしまいます。
グラフ参照先変更
今回のグラフは系列が1つだけです。
元グラフのグラフ系列のFormulaプロパティには下記数式が入っています。
=SERIES(Sheet1!$A$4,Sheet1!$B$4:$B$7,Sheet1!$C$4:$C$7,1)
=SERIES(系列名,横軸ラベルの範囲,データ範囲,系列番号)
今回は系列は一つだけなので系列番号は変更しません。
それ以外の値をセルアドレス形式で、変数fml1～fml3に格納します。
fml1＝系列名
fml2＝横軸ラベルの範囲
fml3＝データ範囲
それらをFormulaプロパティを使用して、対象系列の数式を変更します。
“=Series(” & fml1 & “,” & fml2 & “,” & fml3 & “,1)”
fml1 = Cells(t_row_d, 1).Address(External:=True) '系列名・タイトル用セル fml2 = Range(Cells(t_row_d, 2), Cells(t_row_d + 3, 2)).Address(External:=True) '軸ラベル用セル fml3 = Range(Cells(t_row_d, 3), Cells(t_row_d + 3, 3)).Address(External:=True) '系列値用セル cht.SeriesCollection(1).Formula = "=Series(" & fml1 & "," & fml2 & "," & fml3 & ",1)" 'グラフデータ参照先変更
グラフのタイトルも、セル参照にしています。
cht.ChartTitle.Formula = "=" & fml1今回はシンプルなグラフのコピーをご紹介させていただきました。
大量にあるデータの傾向をつかむには、グラフにして可視化するとわかりやすいですよね。
FormulaプロパティやAddressの使い方などにつきましては、また後日投稿させていただきますね。
参照
系列が1つのグラフを自動大量連続作成（Excel VBA）
「実行時エラー 1004」を出さずに、ワークシート内のグラフを「グラフ 元」以外全て削除（Excel VBA）
グラフの参照先を変えると勝手にグラフの色が変わる現象を解決せよ
系列が複数あるグラフを自動大量連続作成（Excel VBA）
n行毎の改ページ設定 「実行時エラー1004 RangeクラスのPageBreakプロパティを設定できません」の原因（Excel VBA）
■スポンサーリンク
■ランキングに参加しています。 ↓このブログを気に入っていただけましたら、ポチッとお願いします。 人気ブログランキングへ
