【本日のミッション】
Excel VBAにて、系列が複数あるグラフを元に、データ範囲を変更したグラフを大量連続作成せよ。
目次
ミッションの概要
今回は下記データを使わせていただき、グラフにしやすい表に加工しました。
今回のミッションは、この表の年毎のグラフを作りましょう!というものです。
・
・
私は大量のグラフを作成するときは、
- 元になるグラフを1つ作る。
- そのグラフをコピーして参照先を変更するVBAを作成する。
という手順にしています。
今回は2000年のグラフを「グラフ 元」という名前にして、あらかじめ作成しておきます。
グラフを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 kei 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 = 14 '対象データ行(2001年開始行)
t_row_c = 16 'グラフ貼付行(2001年開始行)
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
'■表の2001年から順に処理
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 'グラフ番号
'□グラフ参照変更
For kei = 1 To 3 '系列番号1~3
fml1 = Cells(1, kei + 1).Address(External:=True) '系列名
fml2 = Range(Cells(t_row_d, 1), Cells(t_row_d + 11, 1)).Address(External:=True) '軸ラベル用セル
fml3 = Range(Cells(t_row_d, kei + 1), Cells(t_row_d + 11, kei + 1)).Address(External:=True) '系列値用セル
cht.SeriesCollection(kei).Formula = "=Series(" & fml1 & "," & fml2 & "," & fml3 & "," & kei & ")" 'グラフデータ参照先変更
Next kei
cht.ChartTitle.Formula = Year(Cells(t_row_d, 1)) & "年 平均気温(℃)" 'グラフタイトル変更
t_row_d = t_row_d + 12 '対象データ行+12(次年行)
t_row_c = t_row_c + 14 'グラフ貼付行+14(次年グラフ貼付行)
Loop
Application.ScreenUpdating = True
End Sub
記入したプロシージャのどこかにカーソルを置いてF5キーをクリックしてください。
Excelのシートに、2001年(グラフ 2)~2020年(グラフ 21)が出来上がります。
・
・
おおまかなVBA処理の流れ
- 前回作成のグラフが存在する場合(2回目以降の修正処理を考慮)、元グラフの「グラフ 元」以外削除しておく。
- 表データを上から順に処理を行い、表データがなくなった時点で処理を終了する。
表データは12行ごとの処理とする。 - 元グラフ「グラフ 元」をコピーする。
グラフのコピー行は14行おきとする。 - グラフの名前を変更する。「グラフ 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=21」だったとして、途中でグラフが1個削除されたら・・・「ActiveSheet.ChartObjects.Count=20」になってしまいます。
そんな処理が繰り返されるので、グラフは一つおきに削除され、最後にはエラーが出て止まってしまいます。
そうならないように削除処理を行うときは「Step -1」を使って、「アクティブシートの全グラフの個数」→「1つ目のグラフ」という順番にします。
参考:ワークシート内のグラフを「グラフ 元」以外全て削除(Excel VBA)
元グラフの準備
元グラフは丁寧に作ります。
VBAを一通り処理した後、全てのグラフを確認し、必要であれば最大値や最小値の数値(統一する場合)、項目軸の位置の調整(全てのグラフで正しく表示されるように)などを行い、再度VBA処理を行います。
今回のグラフの参照先は、下記の通りです。
元グラフの名前は「グラフ 元」にしておきます。
(初期値の「グラフ 1」のままだと、ChartObjects.Nameが「Chart 1」になることがあるので、私は「グラフ 元」という名前にしています。)
元グラフを選択し、[ホーム]-[編集]-[検索と選択]ー[オブジェクトの選択と表示]で名前を変更します。
処理行の変更
次年のグラフ作成処理に移行する際、
表データの行番号:「+12」
グラフ貼付行:「+14」
としています。
【処理開始時の数値】 t_row_d = 14 '対象データ行(2001年開始行) t_row_c = 16 'グラフ貼付行(2001年開始行
【次年のグラフ作成処理に移行する際の数値変更】 t_row_d = t_row_d + 12 '対象データ行+12(次年行 t_row_c = t_row_c + 14 'グラフ貼付行+14(次年グラフ貼付行)
Do While Loopを抜けるタイミング
データの処理順は、上記「■処理行の変更」の通りですが、いつまでも永遠に続けるわけではありません。
t_row_d = t_row_d + 12 '対象データ行+12(次年行)
を続けていくと、いつか「t_row_d=254」になる瞬間が訪れます。
そこです!!!
Do While Cells(t_row_d, 1) <> "" '表のデータが空欄になったら終了
Cells(t_row_d, 1)はセルA254です。
セルA254が空欄だと判断されて、Do While Loopを抜け、次の処理へ移ります。
グラフコピー
昔、ActiveSheet.ChartObjects(n).Copyで大量にグラフコピー処理をすると、すごく時間がかかって、ActiveSheet.ChartObjects(n).Chart.ChartArea.Copy で処理すると時短になったことがあって、それ以来「ChartArea」を使っていたんです。
でも、今改めて2つのコードで処理時間を比較してみたら、あんまり違いが無かったんです。PCの環境が昔と違うからかなぁ・・・。
とりあえず、今回は「ChartArea」を使ったコードにしています。
グラフ参照先を変えるとグラフの色が変わってしまう現象
Excelにはありがた迷惑な機能があります。
グラフの参照先を変えると、自動的にグラフの色が変わってしまうことがあります。
「規定の元の色に戻しておきましたよ~」と言わんばかりに。
この現象が起こった時は下記設定を変更し、再度マクロ処理を行います。
[ファイル]-[オプション]
[詳細設定]ー[グラフ]
「グラフのデータ要素の参照先が現在のブックに設定されているプロパティ」のチェックを外します。
これにチェックが付いていると、参照先を変更するたびにブックに設定されているグラフのデータ要素に戻されてしまいます。
参考:グラフの参照先を変えると勝手にグラフの色が変わる現象を解決
グラフ参照先変更
元グラフのグラフ系列1のFormulaプロパティには下記数式が入っています。
=SERIES(Sheet2!$B$1,Sheet2!$A$2:$A$13,Sheet2!$B$2:$B$13,1)
=SERIES(系列名,横軸ラベルの範囲,データ範囲,系列番号)
系列名、横軸ラベルの範囲、データ範囲はセルアドレス形式で、変数fml1~fml3に格納します。
系列は3つあるので、For kei = 1 To 3 ~ Next で1~3回繰り返して、系列番号を取得するようにしています。
fml1=系列名
fml2=横軸ラベルの範囲
fml3=データ範囲
kei=系列番号 1~3
これらをFormulaプロパティを使用して、対象系列の数式を変更します。
“=Series(” & fml1 & “,” & fml2 & “,” & fml3 & kei & “)”
For kei = 1 To 3 '系列番号1~3 fml1 = Cells(1, kei + 1).Address(External:=True) '系列名 fml2 = Range(Cells(t_row_d, 1), Cells(t_row_d + 11, 1)).Address(External:=True) '軸ラベル用セル fml3 = Range(Cells(t_row_d, kei + 1), Cells(t_row_d + 11, kei + 1)).Address(External:=True) '系列値用セル cht.SeriesCollection(kei).Formula = "=Series(" & fml1 & "," & fml2 & "," & fml3 & "," & kei & ")" 'グラフデータ参照先変更 Next kei
グラフのタイトルには「A列の年」& “年 平均気温(℃)”のテキストを使用しています。
cht.ChartTitle.Formula = Year(Cells(t_row_d, 1)) & "年 平均気温(℃)"
大量にあるデータの傾向をつかむには、グラフにして可視化するとわかりやすいですよね。
参照
系列が1つのグラフを自動大量連続作成(Excel VBA)
「実行時エラー 1004」を出さずに、ワークシート内のグラフを「グラフ 元」以外全て削除(Excel VBA)
グラフの参照先を変えると勝手にグラフの色が変わる現象を解決せよ
系列が複数あるグラフを自動大量連続作成(Excel VBA)
n行毎の改ページ設定 「実行時エラー1004 RangeクラスのPageBreakプロパティを設定できません」の原因(Excel VBA)
参照データ数が異なる・参照先が変動する月別グラフを自動大量連続作成(Excel VBA)
複数系列・参照データ数が異なる・参照先が変動する月別グラフを自動大量連続作成(Excel VBA)
大量の画像やグラフ等のオブジェクトで画面表示が遅いのを解決(Excel)
エクセル シートに画像が存在するかどうか(有無)を調べる方法(Excel VBA)
エクセルシート上 全てのオブジェクト(画像・図形・グラフ等)を選択し、削除する(Excel VBA)
エクセルシート上のオブジェクト(図形・画像・グラフ等)の件数を数える方法(Excel VBA)
エクセル シートにグラフが存在するかどうか(有無)を調べる方法(Excel VBA)
エクセル シートに図形が存在するかどうか(有無)を調べる方法(Excel VBA)
エクセル 選択しているセル範囲に写真が存在しているか(有無)を確認(Excel VBA)
エクセル 選択しているセル範囲にグラフが存在しているか(有無)を確認(Excel VBA)
エクセル 選択しているセル範囲に図形が存在しているか(有無)を確認(Excel VBA)
エクセル 選択セル範囲の写真を削除する(Excel VBA)
エクセル 選択セル範囲のグラフを削除する(Excel VBA)
エクセル 選択セル範囲の図形を削除する(Excel VBA)
Excel VBAでワードを起動して文字を入力操作(Excel VBA)
Excel VBAでワードを起動してエクセルの表をワードに貼付け(Excel VBA)
Excel VBAでワードを起動して エクセルのエクセルの表を図としてワードに貼付け(Excel VBA)
Word コピー貼付けした図が白い枠だけ?図が表示されない現象を解決
Excel VBAでワードを起動して グラフをワードに図として貼付け(Excel VBA)