集計表を作成するためには縦項目と横項目が必要になる。
例えば、縦項目をコード、横項目を発行年とする。
コードの場合は、予めコード表を作成しているはずであるので、これをコピーし、縦項目とすれば良い。
出願人、発明者、特許分類などを縦項目にする場合には、「03.不要行の削除」で説明した方法で同じ出願人名称の重複を削除すれば良い。
ただし、出願人、発明者、特許分類などは、通常１件のデータに複数タームを含むので、個別のタームに分離してから処理する必要がある。
件数が少ない場合には、単に分離し、データの最下行に追加してからソートし、重複を除去すれば良い。
例えばＦタームのように１件で50ターム以上あるような場合、2,000件程度でもEXCELの最大行数を超えてしまい、処理できなくなる。
そこで、以下のように、タームを分離し、分離したタームを配列に保存するとともに、このタームを全公報データから消去し、全て消去するまでこの処理を繰り返すようして重複の無いタームを抽出するようにしている。
'変数を宣言
Dim SHEETNAME01 As String, SHEETNAME02 As String, SHEETNAME03 As String
Dim NY1 As Long, NX1 As Integer, NY2 As Long, NX2 As Integer, NY3 As Long, NX3 As Integer
Dim y As Long, x As Integer, k As Long, m As Integer
Dim cellword As String, bcode As String
'配列を宣言
Dim dFI(65000) As String
'シート名称設定
SHEETNAME02 = "FI集計"
SHEETNAME03 = "作業用"
'
'====================
'FIデータを作業用にコピーする
'====================
'処理範囲の行列数を取得
Sheets(SHEETNAME01).Select
Cells(1, 1).Select
ActiveCell.CurrentRegion.Select
NY1 = Selection.Rows.Count
NX1 = Selection.Columns.Count
'コピー
Range(Cells(1, 1), Cells(NY1, 1)).Copy 'FI欄をコピー
Sheets(SHEETNAME03).Select
Cells(1, 1).Select
ActiveSheet.Paste
'
'==================================================
'セル内のタームを分離し、このタームを公報データから除去する
'==================================================
'処理範囲の行列数を取得
Sheets(SHEETNAME03).Select
Cells(1, 1).Select
ActiveCell.CurrentRegion.Select
NY3 = Selection.Rows.Count
NX3 = Selection.Columns.Count
'セル先頭に";"、セル末尾に";CELLEND;"を追加する
For y = 2 To NY3
Cells(y, 1) = ";" & Cells(y, 1) & ";CELLEND;"
Next y
'セル内のタームを分離し、この分離したFIを公報データから除去する
k = 1
For y = 2 To NY3
'セル内のタームを分離
cellword = Cells(y, 1)
If cellword <> ";CELLEND;" Then
For m = 0 To 1000
If Split(cellword, ";")(m) <> "" Then
bcode = ";" & Split(cellword, ";")(m) & ";"
If bcode = ";CELLEND;" Then
Exit For
Else
'配列に登録
k = k + 1
dFI(k) = Split(cellword, ";")(m)
'分離したタームを除去
Columns("A:A").Select
Selection.Replace what:=bcode, Replacement:=";"
Selection.Replace what:=bcode, Replacement:=";"
End If
End If
Next m
End If
Next y
'
'==========================
'配列内容を縦項目として書き出す
'==========================
Sheets(SHEETNAME02).Select
Cells(1, 1) = "FI"
For y = 2 To k
Cells(y, 1) = dFI(y)
Next y
このようにすれば、EXCELに書込み可能な公報件数まで処理可能となり、縦項目を作成できる。