EXCEL VBAで複数の散布図を敷き詰めて並べるでは散布図を都道府県の数だけ敷き詰めて並べた．今回はその散布図一つ一つにデータ系列を追加する．
ゴールは実質公債費比率の時系列の推移
時系列の推移であるから，折れ線グラフが最終的なゴールとなる．データ系列の系列名は市区町村を示し，横軸は年度，縦軸は公債費比率を示す．
テーブルとフィルターの扱いがキモである
一つの散布図を一つの都道府県に割り当てる．具体的にはループ内で Chart オブジェクトを追加し，オブジェクト変数で取得する．
この Chart オブジェクトにはまだデータが入っていない．データを入れるとは Series オブジェクトに値を入れることだが，その値はテーブルから取得することになる．
データテーブルにフィルターをかける．具体的には ListObject オブジェクトに対して AutoFilter メソッドを適用する．フィルターの Criteria は都道府県コードである．
その状態でさらに市区町村コードでフィルターをかけると，ようやく一つの市区町村のデータ系列が時系列で得られる．
市区町村マスターを読み込む
都道府県コードや市区町村コードを取得するには市区町村マスターがあると好都合である．「クエリと接続」で市区町村マスターを右クリックして「読み込み先…」をクリックする．
「データのインポート」で「テーブル」をチェックしOKで市区町村マスターが読み込まれる．
テーブルのフィルター結果を取得するには Intersect 関数が効果的
2019 年 9 月時点でテーブルのフィルター結果を直接取得するプロパティは存在しない．そのため，Intersect 関数を用いて絞り込むことになる．DataBodyRange プロパティと SpecialCells プロパティを引数として与えるとテーブルのフィルター結果が取得できる．
さらに ListColumns プロパティを加えると，フィルターの Criteria となる Range オブジェクトも取得できる．
Intersect 関数の結果が取得できない場合のエラー処理も必要になる．If … Then … Else … End If 節で処理を分岐させることになる．
ループ内でフィルターを使った後はフィルターを解除する
忘れがちであるが，ループ内でフィルターを使った後は「必ず」フィルターを解除しなくてはならない．これを忘れるとループカウンターが増えた後に意図した結果が得られず，悶々と悩むことになる．
コードの組み立て
通常だと完成品のコードを書いて終わりなのだが，今回は自分がどのようにコードを組み立てるのか備忘録として残す意味もあり，順に記していく．
変数宣言はプロシージャの冒頭にまとめるのが通例であるが，必要に応じて都度追加するスタイルなので，改行を一つのまとまりとして宣言する．
コメント行にあるイミディエイトウィンドウへの出力は，変数に値が入っているか確認するために書いている．
一段目のループ
まず，前回のコードを掲載する．一段目のループは都道府県コードをなぞるループカウンターである．ループ内で Chart オブジェクトを追加している．
Sub AddCharts()
Dim mySht1 As Worksheet
Dim myCht As Chart
Dim i As Long
Set mySht1 = Worksheets.Add
With mySht1
.Name = "都道府県"
For i = 1 To 47
'Debug.Print i, 150 * ((i - 1) Mod 6), 150 * ((i - 1) \ 6)
Set myCht = .Shapes.AddChart2(Style:=247, _
XlChartType:=xlXYScatter, _
Left:=150 * ((i - 1) Mod 6), _
Top:=150 * ((i - 1) \ 6), _
Width:=150, _
Height:=150).Chart
'ここに次の処理を書き込む
Next i
End With
End Sub
17 行目に「ここに次の処理を書き込む」とある．
テーブルに一段目のフィルターを適用
フィルターをかける準備を行う．34 行目で Criteria に使うフィルター文字列（ここでは都道府県コード）を正規化するためにカウンター変数を用いている．正規化にはワークシート関数の TEXT 関数を使っている．
37 行目から 45 行目の With ブロックでテーブルを囲み，39 行目でフィルターをかけ, 44 行目でフィルターを解除している．
Sub AddCharts()
Dim mySht1 As Worksheet
Dim myCht As Chart
Dim i As Long
Dim mySht2 As Worksheet
Dim myMerge As ListObject
Dim myPrefCode As String
Dim myPref As String
Set mySht2 = Worksheets("Sheet1")
Set myMerge = mySht2.ListObjects("Merge1")
'Debug.Print myMerge.HeaderRowRange.Address
Dim mySht3 As Worksheet
Dim myLstObj As ListObject
Set mySht3 = Worksheets("Sheet2")
Set myLstObj = mySht3.ListObjects("M_City")
Set mySht1 = Worksheets.Add
With mySht1
.Name = "都道府県"
For i = 1 To 47
'Debug.Print i, 150 * ((i - 1) Mod 6), 150 * ((i - 1) \ 6)
Set myCht = .Shapes.AddChart2(Style:=247, _
XlChartType:=xlXYScatter, _
Left:=150 * ((i - 1) Mod 6), _
Top:=150 * ((i - 1) \ 6), _
Width:=150, _
Height:=150).Chart
'都道府県コードを正規化する
myPrefCode = WorksheetFunction.Text(i, "00")
'Debug.Print myPrefCode
With myLstObj
'都道府県コードでフィルターをかける
.Range.AutoFilter field:=3, Criteria1:=myPrefCode
'ここに次の処理を書き込む
'ループ内でフィルターを使った後はフィルターを解除する
.Range.AutoFilter field:=3
End With
'ここまではデータ系列の設定
Next i
End With
End Sub
41 行目に「ここに次の処理を書き込む」とある．
二段目のループ
44 行目の myRng1 は次のフィルターの Criteria を走査・取得するためのセル範囲を取得している．48 行目は，系列名に入力するための都道府県名を取得している．
52 行目から 55 行目は二段目のループで myRng2 が myRng1 を走査し，次のフィルターの Criteria として機能する．
Sub AddCharts()
Dim mySht1 As Worksheet
Dim myCht As Chart
Dim i As Long
Dim mySht2 As Worksheet
Dim myMerge As ListObject
Dim myPrefCode As String
Dim myPref As String
Set mySht2 = Worksheets("Sheet1")
Set myMerge = mySht2.ListObjects("Merge1")
'Debug.Print myMerge.HeaderRowRange.Address
Dim mySht3 As Worksheet
Dim myLstObj As ListObject
Set mySht3 = Worksheets("Sheet2")
Set myLstObj = mySht3.ListObjects("M_City")
Dim myRng1 As Range
Dim myRng2 As Range
Set mySht1 = Worksheets.Add
With mySht1
.Name = "都道府県"
For i = 1 To 47
'Debug.Print i, 150 * ((i - 1) Mod 6), 150 * ((i - 1) \ 6)
Set myCht = .Shapes.AddChart2(Style:=247, _
XlChartType:=xlXYScatter, _
Left:=150 * ((i - 1) Mod 6), _
Top:=150 * ((i - 1) \ 6), _
Width:=150, _
Height:=150).Chart
'都道府県コードを正規化する
myPrefCode = WorksheetFunction.Text(i, "00")
'Debug.Print myPrefCode
With myLstObj
'都道府県コードでフィルターをかける
.Range.AutoFilter field:=3, Criteria1:=myPrefCode
Set myRng1 = Intersect(.DataBodyRange, _
.Range.SpecialCells(xlCellTypeVisible), _
.ListColumns("CityCode").Range)
'都道府県名を取得
myPref = myRng1.Offset(0, 3).Resize(1).Value
'Debug.Print myRng1.Offset(0, 3).Resize(1).Value
'Debug.Print myPrefCode, myRng1.Address
For Each myRng2 In myRng1
'Debug.Print myRng2.Value
'ここに更に処理を書き込んでいく
Next myRng2
'ループ内でフィルターを使った後はフィルターを解除する
.Range.AutoFilter field:=3
End With
'ここまではデータ系列の設定
Next i
End With
End Sub
54 行目に「ここに更に処理を書き込んでいく」とある．
二段目のフィルター適用，条件分岐，三段目のループ
62 行目から 97 行目の With ブロックでテーブル myMerge を囲み，63 行目で二段目のフィルターを適用し，適用したフィルターを 96 行目で解除している．Criteria はもちろん myRng2 である．myRng2 は実際には市区町村コードを保持しており，テーブルに対して市区町村コードでフィルターをかけている．
66 行目でフィルター結果を取得している．ここでも Intersect 関数が使われる．
68 行目の If … Then … Else … End If 節はフィルター結果が取得できなかった場合，つまりマスターには存在するがトランザクションテーブルには存在しないレコードの場合を想定している．1:N のテーブル結合では当然起こりうる事態である．実際には分岐後 69 行目のように処理を記述せず，何もしないことで結果としてエラー処理としている．
73 行目から 83 行目の三段目のループではちょっと変わった処理をしている．Series オブジェクトには通常 Range オブジェクトを指定してデータを入力するのだが，配列を指定することもできる．ループ内で動的配列を初期化して要素数を増やしつつ値を入力している．
86 行目で Series オブジェクトを追加し，87 行目から 91 行目で実際に系列名，系列Xの値，系列Yの値にデータを書き込んでいる．
Sub AddCharts()
Dim mySht1 As Worksheet
Dim myCht As Chart
Dim i As Long
Dim mySht2 As Worksheet
Dim myMerge As ListObject
Dim myPrefCode As String
Dim myPref As String
Set mySht2 = Worksheets("Sheet1")
Set myMerge = mySht2.ListObjects("Merge1")
'Debug.Print myMerge.HeaderRowRange.Address
Dim mySht3 As Worksheet
Dim myLstObj As ListObject
Set mySht3 = Worksheets("Sheet2")
Set myLstObj = mySht3.ListObjects("M_City")
Dim myRng1 As Range
Dim myRng2 As Range
Dim myRng3 As Range
Dim mySeries As Series
Dim myCity As String
Dim myXValue() As Integer
Dim myValue() As Double
Dim j As Long
Set mySht1 = Worksheets.Add
With mySht1
.Name = "都道府県"
For i = 1 To 47
'Debug.Print i, 150 * ((i - 1) Mod 6), 150 * ((i - 1) \ 6)
Set myCht = .Shapes.AddChart2(Style:=247, _
XlChartType:=xlXYScatter, _
Left:=150 * ((i - 1) Mod 6), _
Top:=150 * ((i - 1) \ 6), _
Width:=150, _
Height:=150).Chart
'都道府県コードを正規化する
myPrefCode = WorksheetFunction.Text(i, "00")
'Debug.Print myPrefCode
With myLstObj
'都道府県コードでフィルターをかける
.Range.AutoFilter field:=3, Criteria1:=myPrefCode
Set myRng1 = Intersect(.DataBodyRange, _
.Range.SpecialCells(xlCellTypeVisible), _
.ListColumns("CityCode").Range)
'都道府県名を取得する
myPref = myRng1.Offset(0, 3).Resize(1).Value
'Debug.Print myRng1.Offset(0, 3).Resize(1).Value
'Debug.Print myPrefCode, myRng1.Address
For Each myRng2 In myRng1
'Debug.Print myRng2.Value
With myMerge
.Range.AutoFilter field:=2, _
Criteria1:=myRng2.Value
Set myRng3 = Intersect(.Range.SpecialCells(xlCellTypeVisible), _
.DataBodyRange)
If myRng3 Is Nothing Then
'フィルター結果が取得できない場合は何もしない
Else
'Debug.Print myRng3.Address
For j = 0 To myRng3.Rows.Count - 1
ReDim Preserve myXValue(j)
ReDim Preserve myValue(j)
'Debug.Print i, j
myCity = myRng3.Cells(j + 1, 3)
myXValue(j) = myRng3.Cells(j + 1, 1)
myValue(j) = myRng3.Cells(j + 1, 4)
Next j
'Seriesオブジェクトに代入
Set mySeries = myCht.SeriesCollection.NewSeries
With mySeries
.Name = myCity
.XValues = myXValue
.Values = myValue
End With
End If
'ループ内でフィルターを使った後はフィルターを解除する
.Range.AutoFilter field:=2
End With
Next myRng2
'ループ内でフィルターを使った後はフィルターを解除する
.Range.AutoFilter field:=3
End With
'ここまではデータ系列の設定
'ここに更に処理を書き込む
Next i
End With
End Sub
まとめ
今回は複数の散布図にデータ系列を追加するところまでを公開した．テーブルとフィルターの扱いが重要であり，グラフのデータ系列との相性は抜群に良い．
多段階のループとフィルターはとっつきにくいが，使いこなすと大きな力を発揮する．その際，マスターテーブルを追加しておくと使い勝手が良い．
次回はグラフの種類を変更し，書式設定を行う．