はじめに
エクセルのグラフでは、OFFSET関数と名前定義を組み合わせて、グラフのデータ範囲を自動で変更することができる。この方法を使い、範囲の開始と終了を指定し、その範囲のグラフを自動で表示させる仕組みをマクロを使わずに実現できる。
その設定について、グラフが1つで系列も少なければいいのだが、複数のグラフの複数の系列にそれぞれ名前定義を作成し、グラフ範囲の設定を行うのは面倒だ。そのため、マクロを使って、設定を自動化できないか検討した。
作成したいマクロのイメージ
既にあるグラフから、軸ラベル範囲と系列のデータ範囲を読み取る。
読み取った範囲から、自動変更用の名前定義を作成する。
作成した名前定義を使って、グラフの各系列の設定を行う。
これらを複数のグラフに対して行う。
作成したマクロの概要
連続するデータの系列のみを対象とし、指定した範囲の開始と終了が軸ラベル範囲にある場合、その系列をコレクションに追加し、処理したい系列のコレクションを作成した。
コレクションの作成については、ChartオブジェクトのFullSeriesCollectionメソッドを使って取得したFullSeriesCollectionに対して、For Each～Nextを使って、Seriesオブジェクトと各種情報をコレクション化している。そのコレクションの各系列に対して、名前定義を作成し、系列に設定する。
この系列への設定の際、Formulaプロパティで設定しようとした所、さっきまで設定できていたのに、突然、エラーが出て設定できない事があった。調べた所、FormulaR1C1プロパティで設定しないと、安定的に動作しないようだ。以下のページが参考になった。
コレクション化したデータ内容
①系列オブジェクト：設定対象の系列オブジェクト
②軸ラベル範囲の文字列：設定対象のグラフの軸ラベル範囲の文字列
③R1C1形式の軸ラベル範囲の文字列：R1C1形式の軸ラベル範囲の文字列
④軸ラベル方向：軸ラベルの方向に合わせて「横」または「縦」の文字列
⑤系列範囲の文字列：設定対象の系列範囲の文字列
⑥R1C1形式の系列範囲の文字列：R1C1形式の系列範囲の文字列
⑦系列名：「指定系列範囲」+系列番号、名前定義用の系列名称
⑧グラフ名：設定対象の系列があるシート+グラフの名前
作成した名前定義
① 範囲開始：軸ラベル範囲の開始を入力するセルを設定
② 範囲終了：軸ラベル範囲の終了を入力するセルを設定
③ 軸ラベル範囲全体：軸ラベル範囲の行・列の向きに合わせた行または列全体を設定
④ 開始位置：MATCH関数を使い、軸ラベル範囲全体における範囲開始の値の位置を設定
⑤ 表示件数：範囲終了の値の位置から開始位置を引き、表示する件数を設定
⑥ 指定軸ラベル範囲：OFFSET関数を使い、範囲開始から終了までの軸ラベル範囲を設定
⑦ 指定系列範囲：OFFSET関数を使い、範囲開始から終了までの系列データ範囲を設定
※指定軸ラベル範囲、指定系列範囲のOFFSET関数は、行または列の最初のセルを起点に、開始位置まで移動し、表示件数の幅または高さとする
動作手順
- 軸ラベル範囲の開始・終了を入力するセルを「範囲開始」「範囲終了」として名前定義
- 対象となる系列をコレクション化
2-1. 設定されている軸ラベル範囲、系列データ範囲を取得
2-2. 連続したデータ範囲の場合、指定した開始・終了が軸ラベル範囲にあるか確認
2-3. 指定した範囲がある場合、軸ラベルの向きを確認し、軸ラベル方向を設定
2-4. 各データをコレクション化 - 作成した系列コレクションに対して処理を行う
3-1. 軸ラベル全体を名前定義
3-1-1. 設定されている軸ラベル範囲の起点のアドレスを取得
3-1-2. 行または列全体を「軸ラベル範囲全体」として名前定義
3-2. MATCH関数を使い、「開始位置」、「表示件数」を名前定義
3-3. 指定軸ラベル範囲、指定系列範囲を名前定義
3-3-1. 設定されている軸ラベル範囲の起点から先頭行または先頭列セルを取得
3-3-2. 設定されている系列範囲の起点から先頭行または先頭列セルを取得
3-3-3. OFFSET関数を使い、「指定軸ラベル範囲」「指定系列範囲」を名前定義
3-4. 系列に名前定義を設定
3-4-1. 系列オブジェクトのFolmulaR1C1の軸ラベル、系列範囲を名前定義に置換
3-4-2. 系列オブジェクトのFolmulaR1C1に、名前定義に置き換えた文字列を設定
補足
- 同じグラフの各系列で重複して軸ラベルの名前定義を追加しているが、同じ名称で名前定義を追加すると上書きされるため、名前定義を追加済みかどうかの確認は行っていない
完成したマクロ
Set_DynamicChartRange
Public Sub Set_DynamicChartRange()
Dim TargetWorksheet As Worksheet
Dim StartItemRange As Range
Dim EndItemRange As Range
Dim TargetSeriesCollection As Collection
Dim TargetChartObject As ChartObject
Dim TargetSeries As Series
Dim myItem As Collection
Dim TargetDirection As String
Dim StartFormula As String
Dim EndFormula As String
Dim CountFormula As String
Dim TargetAxesStr As String
Dim TargetAxesStartStr As String
Dim TargetSeriesStr As String
Dim TargetSeriesStartStr As String
Dim TargetSeriesIndex As String
Dim CharStart As Long
Dim CharLength As Long
Dim ChangeFormula As String
Set TargetWorksheet = ActiveSheet
Set StartItemRange = TargetWorksheet.Range("C3") '開始項目入力セルを設定
Set EndItemRange = TargetWorksheet.Range("C4") '終了項目入力セルを設定
TargetWorksheet.Names.Add Name:=TargetWorksheet.Name & "_範囲開始", RefersTo:="='" & TargetWorksheet.Name & "'!" & StartItemRange.Address
TargetWorksheet.Names.Add Name:=TargetWorksheet.Name & "_範囲終了", RefersTo:="='" & TargetWorksheet.Name & "'!" & EndItemRange.Address
Set TargetSeriesCollection = New Collection
For Each TargetChartObject In TargetWorksheet.ChartObjects
For Each TargetSeries In TargetChartObject.Chart.FullSeriesCollection
CharStart = InStr(TargetSeries.Formula, ",") + 1
CharLength = InStr(CharStart, TargetSeries.Formula, ",") - CharStart
TargetAxesStr = Mid(TargetSeries.Formula, CharStart, CharLength)
CharStart = InStr(CharStart, TargetSeries.Formula, ",") + 1
CharLength = InStr(CharStart, TargetSeries.Formula, ",") - CharStart
TargetSeriesStr = Mid(TargetSeries.Formula, CharStart, CharLength)
TargetSeriesIndex = Replace(Mid(TargetSeries.Formula, InStrRev(TargetSeries.Formula, ",") + 1), ")", "")
If Len(TargetSeries.Formula) - Len(Replace(TargetSeries.Formula, ",", "")) = 3 And InStr(TargetSeriesStr, ":") > 0 Then
If WorksheetFunction.CountIf(TargetWorksheet.Range(TargetAxesStr), StartItemRange.Value) _
And WorksheetFunction.CountIf(TargetWorksheet.Range(TargetAxesStr), EndItemRange.Value) Then
If TargetWorksheet.Range(TargetAxesStr).Columns.Count > TargetWorksheet.Range(TargetAxesStr).Rows.Count Then
TargetDirection = "横"
Else
TargetDirection = "縦"
End If
Set myItem = New Collection
myItem.Add TargetSeries, "系列"
myItem.Add TargetAxesStr, "軸ラベル範囲"
myItem.Add TargetWorksheet.Range(TargetAxesStr).Address(ReferenceStyle:=xlR1C1), "軸ラベル範囲R1C1"
myItem.Add TargetDirection, "軸ラベル方向"
myItem.Add TargetSeriesStr, "系列範囲"
myItem.Add TargetWorksheet.Range(TargetSeriesStr).Address(ReferenceStyle:=xlR1C1), "系列範囲R1C1"
myItem.Add "指定系列範囲" & TargetSeriesIndex, "系列名"
myItem.Add TargetWorksheet.Name & "_" & Replace(TargetChartObject.Name, " ", ""), "グラフ名"
TargetSeriesCollection.Add myItem
Set myItem = Nothing
End If
End If
Next TargetSeries
Next TargetChartObject
For Each myItem In TargetSeriesCollection
TargetAxesStartStr = Left(myItem("軸ラベル範囲"), InStr(myItem("軸ラベル範囲"), ":") - 1)
Select Case myItem("軸ラベル方向")
Case "横"
TargetWorksheet.Names.Add Name:=myItem("グラフ名") & "_軸ラベル範囲全体", RefersTo:="=" & TargetWorksheet.Range(TargetAxesStartStr).EntireRow.Address
Case "縦"
TargetWorksheet.Names.Add Name:=myItem("グラフ名") & "_軸ラベル範囲全体", RefersTo:="=" & TargetWorksheet.Range(TargetAxesStartStr).EntireColumn.Address
End Select
StartFormula = "MATCH(" & TargetWorksheet.Name & "_範囲開始," & myItem("グラフ名") & "_軸ラベル範囲全体" & ",0)"
EndFormula = "MATCH(" & TargetWorksheet.Name & "_範囲終了," & myItem("グラフ名") & "_軸ラベル範囲全体" & ",0)"
CountFormula = EndFormula & " - " & StartFormula & " +1"
TargetWorksheet.Names.Add Name:=myItem("グラフ名") & "_開始位置", RefersTo:="=" & StartFormula
TargetWorksheet.Names.Add Name:=myItem("グラフ名") & "_表示件数", RefersTo:="=" & CountFormula
TargetSeriesStartStr = Left(myItem("系列範囲"), InStr(myItem("系列範囲"), ":") - 1)
Select Case myItem("軸ラベル方向")
Case "横"
TargetAxesStartStr = Replace(TargetAxesStartStr, Mid(TargetAxesStartStr, InStr(TargetAxesStartStr, "$") + 1), "A") & Mid(TargetAxesStartStr, InStrRev(TargetAxesStartStr, "$"))
TargetSeriesStartStr = Replace(TargetSeriesStartStr, Mid(TargetSeriesStartStr, InStr(TargetAxesStartStr, "$") + 1), "A") & Mid(TargetSeriesStartStr, InStrRev(TargetSeriesStartStr, "$"))
TargetWorksheet.Names.Add Name:=myItem("グラフ名") & "_指定軸ラベル範囲", RefersTo:="=OFFSET(" & TargetAxesStartStr & ",0," & myItem("グラフ名") & "_開始位置 -1,1," & myItem("グラフ名") & "_表示件数)"
TargetWorksheet.Names.Add Name:=myItem("グラフ名") & "_" & myItem("系列名"), RefersTo:="=OFFSET(" & TargetSeriesStartStr & ",0," & myItem("グラフ名") & "_開始位置 -1,1," & myItem("グラフ名") & "_表示件数)"
Case "縦"
TargetAxesStartStr = Replace(TargetAxesStartStr, Mid(TargetAxesStartStr, InStrRev(TargetAxesStartStr, "$") + 1), "1")
TargetWorksheet.Names.Add Name:=myItem("グラフ名") & "_指定軸ラベル範囲", RefersTo:="=OFFSET(" & TargetAxesStartStr & "," & myItem("グラフ名") & "_開始位置 -1,0," & myItem("グラフ名") & "_表示件数,1)"
TargetSeriesStartStr = Replace(TargetSeriesStartStr, Mid(TargetSeriesStartStr, InStrRev(TargetSeriesStartStr, "$") + 1), "1")
TargetWorksheet.Names.Add Name:=myItem("グラフ名") & "_" & myItem("系列名"), RefersTo:="=OFFSET(" & TargetSeriesStartStr & "," & myItem("グラフ名") & "_開始位置 -1,0," & myItem("グラフ名") & "_表示件数,1)"
End Select
ChangeFormula = Replace(myItem("系列").FormulaR1C1, myItem("軸ラベル範囲R1C1"), myItem("グラフ名") & "_指定軸ラベル範囲")
ChangeFormula = Replace(ChangeFormula, myItem("系列範囲R1C1"), myItem("グラフ名") & "_" & myItem("系列名"))
myItem("系列").FormulaR1C1 = ChangeFormula
Next myItem
MsgBox "グラフ設定が完了しました"
End Sub
サンプルファイル保存先：