複数項目の年別推移を見るには折線グラフが良い。
ただし、円グラフと同じで、項目数が多すぎると折線が混じり合って個々の項目の年別推移が読み取れなくなる。
そこで、項目数はベストテン程度に絞り込むようにしている。
集計表の構成は以下のとおり。
縦項目：コード、出願人、発明者、特許分類などと、縦合計欄
横項目：発行年と、横合計欄
'変数を宣言
Dim SHEETNAME02 As String
Dim NY2 As Long, NX2 As Integer
'シート名称を設定
SHEETNAME02 = "一桁年別折れ線グラフ"
'
'===================
'折れ線グラフを作成する
'===================
'処理範囲の行列数を取得
Sheets(SHEETNAME02).Select
Cells(1, 1).Select
ActiveCell.CurrentRegion.Select
NY2 = Selection.Rows.Count
NX2 = Selection.Columns.Count
'折れ線グラフを作成
Range(Cells(1, 1), Cells(NY2 - 1, NX2 - 1)).Select
With Cells(NY2 + 4, 2)
ActiveSheet.Shapes.AddChart Left:=.Left, Top:=.Top
End With
ActiveSheet.ChartObjects(1).Select
ActiveChart.ChartType = xlLineMarkers
ActiveChart.PlotBy = xlRows
With ActiveSheet.ChartObjects(1).Chart
.HasTitle = True
.ChartTitle.Text = "コード別の年別発行件数"
End With
ActiveChart.ChartTitle.Select
Selection.Format.TextFrame2.TextRange.Font.Size = 14
With ActiveSheet.ChartObjects(1).Chart.Axes(xlValue)
.HasTitle = True
.AxisTitle.Text = "発行件数"
.AxisTitle.Orientation = xlVertical
End With
With ActiveSheet.ChartObjects(1).Chart.Axes(xlCategory)
.HasTitle = True
.AxisTitle.Text = "発行年"
End With
With ActiveSheet.ChartObjects(1).Chart.SeriesCollection
For y = 1 To NY2 - 2
.Item(y).Format.Line.Weight = 2
Next y
End With
'グラフの位置と大きさを設定
With ActiveSheet.ChartObjects(1)
.Left = 100
.Top = 300
.Width = 1000
.Height = 400
End With
'
これにより、折線グラフとその右横に項目名が書き出される。
グラフのタイトルはマクロ内で「コード別の年別発行件数」に設定したが、これを変更して別のタイトルにすることもできる。
件数は書き出されていないが、作成したグラフで１つの折線をクリックすると、集計表の項目が薄く色づけされるので元の集計データを読み取ることができる。