項目数が多い場合の年別推移を見るには数値付きバブルチャートが適している。
作成方法は集計表の行高さと列幅を円(バブル)が書き込める大きさに設定し、各セル毎に件数に比例した面積の円を書き込むようにすれば良い。
ここで使用した集計表の構成は以下のとおり。
縦項目：コード、出願人、発明者、特許分類などと、縦合計欄
横項目：発行年と、横合計欄
マクロはマクロは次のとおり。
'変数を宣言
Dim SHEETNAME02 As String
Dim NY2 As Long, NX2 As Integer
Dim y As Long, x As Integer
Dim vmax As Single, sqrvmax As Double, hcell As Single, dcircle As Single
Dim nmax As Single, maxwrd As Integer, nhiritu as Single, celldfh As Integer
'シート名称設定
SHEETNAME02 = "年別バブル"
'
'セルデフォルト高さ設定
celldfh = 50
'
'=================================
'集計表に基づきバブルチャートを作成する
'=================================
'処理範囲の行列数を取得
Sheets(SHEETNAME02).Select
Cells(1, 2).Select
ActiveCell.CurrentRegion.Select
NY2 = Selection.Rows.Count
NX2 = Selection.Columns.Count
'コードの最大文字長さを抽出
maxwrd = 10
For y = 2 To NY2
If Len(Cells(y, 1)) > maxwrd Then maxwrd = Len(Cells(y, 1))
Next y
'全セルを選択
ActiveCell.CurrentRegion.Select
'全セル高さを設定
Selection.RowHeight = celldfh
If maxwrd > 15 Then Selection.RowHeight = Selection.RowHeight * (maxwrd / 15)
If NY2 - 2 < 4 Then Selection.RowHeight = 70
If NY2 - 2 > 25 Then Selection.RowHeight = 400 / (NY2 - 2)
If 400 / (NY2 - 2) < 30 Then Selection.RowHeight = 35
'全セル幅を設定
Selection.ColumnWidth = 14
If NX2 - 2 > 12 Then Selection.ColumnWidth = 140 / (NX2)
'A列のセル幅を修正
Columns("A:A").ColumnWidth = 25 * (maxwrd / 15)
If 25 * (maxwrd / 15) > 30 Then Columns("A:A").ColumnWidth = 30
'合計欄のセル幅を修正
If Cells(1, NX2 - 1) = "合計" Then Columns(NX2 - 1).ColumnWidth = 7
If Cells(1, NX2) = "合計" Then Columns(NX2).ColumnWidth = 7
'ヘッダのセル高さを修正
Rows(1).RowHeight = 42
'最終セルの高さを修正
Rows(NY2).RowHeight = 30
'円の最大値を算出
vmax = 0
For y = 2 To NY2 - 1
For x = 2 To NX2 - 1
If Cells(y, x) > vmax Then
vmax = Cells(y, x)
End If
Next x
Next y
'セル高さ算出
hcell = Cells(4, 2).Top - Cells(3, 2).Top
If hcell >= 16 Then hcell = 16 'セル高さが16以上ならば16とする
'直径の補正値を算出
nhiritu = Sqr(vmax) * 10
'バブル(円)を書き込む
For y = 2 To NY2 - 1
For x = 2 To NX2 - 1
'件数に応じて円直径を補正
If vmax < 20 Then dcircle = Sqr(hcell * nhiritu * (Cells(y, x) / vmax)) + 1
If vmax >= 20 Then dcircle = Sqr(hcell * 100 * (Cells(y, x) / vmax)) * 0.8 + 1
If vmax > 500 Then dcircle = Sqr(hcell * 100 * (Cells(y, x) / vmax)) + 1
'バブル(円)書込み
If Cells(y, x) > 0 Then
ActiveSheet.Shapes.AddShape(msoShapeOval, _
(Cells(y, x + 1).Left - Cells(y, x).Left) / 2 + Cells(y, x).Left - dcircle / 2, _
(Cells(y + 1, x).Top - Cells(y, x).Top) / 2 + Cells(y, x).Top - dcircle / 2, _
dcircle, _
dcircle).Select
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 44
End If
Next x
Next y
'
これにより、集計表を修正して数値付きバブルチャートを作成できる。