B08D.折線グラフ

複数項目の年別推移を見るには折線グラフが良い。

ただし、円グラフと同じで、項目数が多すぎると折線が混じり合って個々の項目の年別推移が読み取れなくなる。

そこで、項目数はベストテン程度に絞り込むようにしている。

集計表の構成は以下のとおり。

縦項目：コード、出願人、発明者、特許分類などと、縦合計欄

横項目：発行年と、横合計欄

'変数を宣言

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

'

これにより、折線グラフとその右横に項目名が書き出される。

グラフのタイトルはマクロ内で「コード別の年別発行件数」に設定したが、これを変更して別のタイトルにすることもできる。

件数は書き出されていないが、作成したグラフで１つの折線をクリックすると、集計表の項目が薄く色づけされるので元の集計データを読み取ることができる。