動向分析では、企業がどのような技術に注力しているか分析することも重要である。
そこで、出願人別の集計表を作成するが、基本的には縦項目に出願人を設定するだけであり、コード別集計と大きな違いは無い。
ただし、出願人名称が変更されていたり、異なる表記が混在する場合には、そのまま集計すると発行件数の順位が異なってしまい、間違った分析を行なう恐れがある。
そこで、出願人別の集計では出願人名称を統一してから処理するようにしている。
また、出願人別の発明者人口や、新規参入企業も分析項目として重要である。
また、出願人別や発明者別の発行件数を集計する場合には持ち分で処理している。
例えば、４社で共同出願したものは持ち分を0.25とし、５名で発明した場合は持ち分を0.2とすることになる。
まず、出願人名称の修正では以下のような変換表を使用している。
元の出願人名称 変換後の出願人名称
アステックス、セラピューティックス、リミテッド アステックス・セラピューティクス・リミテッド
アストラゼネカアーベー アストラゼネカ・アクチエボラーグ
アストラゼネカアクチボラグ アストラゼネカ・アクチエボラーグ
アストラゼネカエービー アストラゼネカ・アクチエボラーグ
新規登録するかどうかはシート「出願人別集計」の集計データで件数が多い企業の名称を確認すればわかる。
多いのは、外国法人であり、カタカナの表記方法や略称などの違いで別の出願人となってしまうことがある。
この場合は、名称順にソートすれば簡単に確認できる。
出願人名称を変換するために以下のExcelマクロを作成した。
この名称変換ではReplaceコマンドで一括変換している。
Sub 出願人名称変換()
'
'同じ法人で呼称が異なる出願人名称を統一するために、公報コピーデータの出願人名称を
'出願人名称変換表に登録された出願人名称に置換する
'
'変数を宣言
Dim SHEETNAME01 As String, SHEETNAME02 As String
Dim NY1 As Long, NX1 As Integer, NY2 As Long, NX2 As Integer
Dim y As Long, k As Long, m As Long
'配列を宣言
Dim code1() As String
Dim code2() As String
'シート名称を設定する
SHEETNAME01 = "出願人名称変換表"
SHEETNAME02 = "重複なしデータ"
'
'======================
'新旧の出願人名称を配列に読み込む
'======================
'処理範囲の行列数を取得
Sheets(SHEETNAME01).Select
Cells(1, 1).Select
ActiveCell.CurrentRegion.Select
NY1 = Selection.Rows.Count
NX1 = Selection.Columns.Count
'配列数を設定
ReDim code1(NY1), code2(NY1)
'新旧の出願人名称を配列に読み込む
Sheets(SHEETNAME01).Select
For y = 2 To NY1
code1(y) = Cells(y, 1)
code2(y) = Cells(y, 2)
Next y
m = NY1
'
'==========================================
'読込んだ元の出願人名称にしたがって登録された出願人名称に置換する
'==========================================
'処理範囲の行列数を取得
Sheets(SHEETNAME02).Select
Cells(1, 1).Select
ActiveCell.CurrentRegion.Select
NY2 = Selection.Rows.Count
NX2 = Selection.Columns.Count
'出願人名称を置換
Range("E:E").Select
For k = 2 To m
Selection.Replace what:=code1(k), Replacement:=code2(k)
Next k
'
'==============
Cells(1, 1).Select
'MsgBox "終了しました"
'
End Sub
・出願人別の発明者人口では以下のマクロを使用している。
'====================================
'発行年毎に出願人と発明者とをシート「作業用」にコピーし、
'発明者を展開し、出願人毎の発明者数を集計し、書込む
'====================================
'ヘッダ設定
Sheets(SHEETNAME05).Select
Cells(1, 1) = "出願人"
Cells(1, 2) = "発明者"
Cells(1, 3) = "ソートキー"
'処理範囲の行列数を取得
Sheets(SHEETNAME02).Select
Cells(1, 1).Select
ActiveCell.CurrentRegion.Select
NY2 = Selection.Rows.Count
NX2 = Selection.Columns.Count
'配列数を設定
ReDim dAP(NY2), dname(NY2), dnn(NY2)
'初期化
For x = 2 To NX2
For y = 2 To NY2
Cells(y, x) = 0
Next y
Next x
'発行年毎に発明者を展開
For x2 = 2 To NX2
k = 1
Sheets(SHEETNAME02).Select
byear = Cells(1, x2)
'公報データからbAPに一致する公報の発明者と発行年をコピー
Sheets(SHEETNAME01).Select
Cells(1, 1).Select
ActiveCell.CurrentRegion.Select
NY1 = Selection.Rows.Count
NX1 = Selection.Columns.Count
'配列数を設定
ReDim dAP(NY1), dname(NY1), dnn(NY1)
For y1 = 2 To NY1
If Cells(y1, nclm3) = byear Then
For y2 = 2 To NY2
If InStr(Cells(y1, nclm1), ctate(y2)) > 0 Then
k = k + 1
dAP(k) = Cells(y1, nclm1)
dname(k) = Cells(y1, nclm2)
Exit For
End If
Next y2
End If
Next y1
'シート「作業用」に書込み
Sheets(SHEETNAME05).Select
For y5 = 2 To k
Cells(y5, 1) = dAP(y5)
Cells(y5, 2) = dname(y5)
Next y5
'処理範囲の行列数を取得
Sheets(SHEETNAME05).Select
Cells(1, 1).Select
ActiveCell.CurrentRegion.Select
NY5 = Selection.Rows.Count
NX5 = Selection.Columns.Count
'発明者を展開
m = 1 '追加した行数+1
For y5 = 2 To NY5
cellword = Cells(y5, 2)
nwd = Len(cellword)
pos = InStr(cellword, ";")
n = 1
'発明者の数を調べる
If pos > 0 Then
Do While pos > 0
If pos > 0 Then
If nwd - pos > 0 Then
cellword = Right(cellword, nwd - pos)
pos = InStr(cellword, ";")
nwd = Len(cellword)
n = n + 1
Else
n = n + 1
pos = 0
End If
End If
Loop
End If
'共同発明者を区切り記号";"に基づき分割し、最下行に追加する
'元のデータを筆頭発明者のみに修正する
cellword = Cells(y5, 2)
For k = 1 To n - 1
bcode = Split(cellword, ";")(k)
Range(Cells(y5, 1), Cells(y5, 2)).Copy
ActiveSheet.Paste Destination:=Cells(NY5 + m, 1)
Cells(NY5 + m, 2) = bcode
m = m + 1
Next k
'筆頭のみに書き換え
If n > 1 Then
bcode = Split(cellword, ";")(0)
Cells(y5, 2) = bcode
End If
Next y5
'処理範囲の行列数を取得
Sheets(SHEETNAME05).Select
Cells(1, 1).Select
ActiveCell.CurrentRegion.Select
NY5 = Selection.Rows.Count
NX5 = Selection.Columns.Count
If NY5 > 1 Then
'ソートキーを作成
For y5 = 2 To NY5
Cells(y5, 3) = Cells(y5, 1) & ";" & Cells(y5, 2)
Next y5
'ソート
Range(Cells(1, 1), Cells(NY5, NX5)).Sort Key1:=Cells(1, 3), Order1:=xlAscending, Header:= _
xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
SortMethod:=xlPinYin
'次行のソートキー(=3)が同じならば当該行をクリア/重複した発明者を削除
For y5 = 2 To NY5
If Cells(y5, 3) = Cells(y5 + 1, 3) Then
Rows(y5).Clear
End If
Next y5
'出願人でソートし、空白行を削除
Range(Cells(1, 1), Cells(NY5, NX5)).Sort Key1:=Cells(1, 1), Order1:=xlAscending, Header:= _
xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
SortMethod:=xlPinYin
'処理範囲の行列数を取得
Sheets(SHEETNAME05).Select
Cells(1, 1).Select
ActiveCell.CurrentRegion.Select
NY5 = Selection.Rows.Count
NX5 = Selection.Columns.Count
'出願人毎の発明者数を集計し配列に読込み
bn = 0
nAP = 1
For y5 = 2 To NY5
If Cells(y5, 1) = Cells(y5 + 1, 1) Then
bn = bn + 1
Else
bn = bn + 1
nAP = nAP + 1
dAP(nAP) = Cells(y5, 1)
dnn(nAP) = bn
bn = 0
End If
Next y5
'出願人別発明者リストに書込み
Sheets(SHEETNAME02).Select
For y2 = 2 To NY2
For y5 = 2 To nAP
If InStr(dAP(y5), Cells(y2, 1)) > 0 Then
Cells(y2, x2) = Cells(y2, x2) + dnn(y5)
End If
Next y5
Next y2
'クリア
Worksheets(SHEETNAME05).Activate
Cells.Select
Selection.Delete Shift:=xlUp
'ヘッダ設定
Cells(1, 1) = "出願人"
Cells(1, 2) = "発明者"
Cells(1, 3) = "ソートキー"
End If
Next x2
'
・新規参入企業は以下の条件で抽出している。
調査開始年の発行件数が0件である(プログラムでは調査開始年の出願人を除外することにより実現している)。
発行件数が平均件数以上でかつ平均増加率以上であるか、または最終年の件数が5件以上でかつ最近に新規参入した出願人である。
以下に作成したExcelマクロを示す。
Sub 新規参入公報抽出()
'
'新規参入集計のための公報データを抽出する
'
'変数を宣言
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, by As Long, cellword As String, bcode As String
'配列を宣言
Dim dwrd(65000) As String
'シート名称設定
SHEETNAME01 = "新規参入公報"
SHEETNAME02 = "重複なしデータ"
SHEETNAME03 = "作業用"
'
'カラム数を指定
nclm1 = 11 '発行年
nclm2 = 5 '出願人
'
'クリア
Worksheets(SHEETNAME01).Activate
Cells.Select
Selection.Delete Shift:=xlUp
Worksheets(SHEETNAME03).Activate
Cells.Select
Selection.Delete Shift:=xlUp
'
'===================
'調査開始年の出願人を抽出する
'===================
'処理範囲の行列数を取得
Sheets(SHEETNAME02).Select
Cells(1, 2).Select
ActiveCell.CurrentRegion.Select
NY2 = Selection.Rows.Count
NX2 = Selection.Columns.Count
'発行年でソート
Range(Cells(1, 1), Cells(NY2, NX2)).Sort Key1:=Cells(1, nclm1), Order1:=xlAscending, Header:= _
xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
SortMethod:=xlPinYin
'発行年=開始年の最終行を確認
by = 1
For y = 2 To NY2
If Cells(y, nclm1) <> Cells(y + 1, nclm1) Then
by = y
Exit For
End If
Next y
'発行年=開始年の公報データをコピー
Sheets(SHEETNAME02).Select
Range(Cells(1, nclm2), Cells(by, nclm2)).Select
Selection.Copy
Sheets(SHEETNAME03).Select
Range("A1").Select
ActiveSheet.Paste
'
'=============================================
'セル内のタームを分離し、このタームを公報データから除去する
'セル内に同一分類が複数ある場合があるので分離したタームを二回削除する
'※重複例：特開2007-294830のFIはH01L31/04,Rが重複していた
'=============================================
'処理範囲の行列数を取得
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
'セル内のタームを分離し、この分離したタームを公報データから除去する
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
dwrd(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(SHEETNAME03).Select
Columns(1).Clear
Cells(1, 1) = "分離ターム"
For y = 2 To k
Cells(y, 1) = dwrd(y)
Next y
'
'================
'重複したタームを削除する
'================
'処理範囲の行列数を取得
Sheets(SHEETNAME03).Select
Cells(1, 1).Select
ActiveCell.CurrentRegion.Select
NY3 = Selection.Rows.Count
NX3 = Selection.Columns.Count
'A列のタームでソート
Range(Cells(1, 1), Cells(NY3, NX3)).Sort Key1:=Cells(1, 1), Order1:=xlAscending, Header:= _
xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
SortMethod:=xlPinYin
'次行のタームが同じタームならば当該行を削除
For y = 2 To NY2
If Cells(y, 1) = Cells(y + 1, 1) Then Rows(y).Clear
Next y
'ソートして空白行を削除
Range(Cells(1, 1), Cells(NY3, NX3)).Sort Key1:=Cells(1, 1), Order1:=xlAscending, Header:= _
xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
SortMethod:=xlPinYin
'
'=================================
'開始年出願人以外の出願人を含む公報データを抽出する
'=================================
'処理範囲の行列数を取得
Sheets(SHEETNAME03).Select
Cells(1, 1).Select
ActiveCell.CurrentRegion.Select
NY3 = Selection.Rows.Count
NX3 = Selection.Columns.Count
'開始年出願人名を配列に読込み
For y = 2 To NY3
dwrd(y) = Cells(y, 1)
Next y
'処理範囲の行列数を取得
Sheets(SHEETNAME02).Select
Cells(1, 1).Select
ActiveCell.CurrentRegion.Select
NY2 = Selection.Rows.Count
NX2 = Selection.Columns.Count
'配列以外の出願人を含む公報データにマーク
Columns(NX2 + 1).Clear
For y = 2 To NY2
Cells(y, NX2 + 1) = 0
For k = 2 To NY3
If InStr(Cells(y, nclm2), dwrd(k)) > 0 Then
Cells(y, NX2 + 1) = 1
Exit For
End If
Next k
Next y
'マーク欄でソート
Range(Cells(1, 1), Cells(NY2, NX2 + 1)).Sort Key1:=Cells(1, NX2 + 1), Order1:=xlAscending, Header:= _
xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
SortMethod:=xlPinYin
'
'=====================
'新規参入の公報データをコピーする
'=====================
'新規参入公報の最終行を確認
by = 1
For y = 2 To NY2
If Cells(y, NX2 + 1) <> Cells(y + 1, NX2 + 1) Then
by = y
Exit For
End If
Next y
'コピー
Sheets(SHEETNAME02).Select
Range(Cells(1, 1), Cells(by, NX2 + 1)).Select
Selection.Copy
Sheets(SHEETNAME01).Select
Range("A1").Select
ActiveSheet.Paste
'
'重複なしデータのマークデータをクリア
Sheets(SHEETNAME02).Select
Columns(NX2 + 1).Clear
'
'==============
Sheets(SHEETNAME01).Select
Cells(1, 1).Select
'MsgBox "終了しました"
'
End Sub
さらに次のマクロにより評価している。
'=================================
'平均件数以上でかつ平均増加率以上の出願人を抽出する
'=================================
'平均件数以上でかつ平均増加率以上の出願人を抽出
Cells(1, NX2 + 3) = "新規候補"
nav = Cells(NY2 + 3, NX2 + 1) '平均件数"
pav = Cells(NY2 + 4, NX2 + 1) '平均増加率
For y = 2 To NY2
Cells(y, NX2 + 3) = 0
If Cells(y, NX2 + 1) > nav Then
If Cells(y, NX2 + 2) > pav Then
Cells(y, NX2 + 3) = 1
End If
End If
Next y
'最終年の件数が5件以上でかつ最近に新規参入した出願人を抽出
For y = 2 To NY2
If Cells(y, 2) = 0 Then
If Cells(y, 3) = 0 Then
'MsgBox Cells(y, NX2)
If Cells(y, NX2) >= 5 Then Cells(y, NX2 + 3) = 1
End If
End If
Next y
'処理範囲の行列数を取得
Sheets(SHEETNAME02).Select
Cells(1, 1).Select
ActiveCell.CurrentRegion.Select
NY2 = Selection.Rows.Count
NX2 = Selection.Columns.Count
'ソート
Range(Cells(1, 1), Cells(NY2, NX2)).Sort Key1:=Cells(1, NX2), Order1:=xlDescending, Header:= _
xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
SortMethod:=xlPinYin
'新規候補=0を分離
For y = 2 To NY2
If Cells(y, NX2) = 0 Then
Rows(y).Insert Shift:=xlTodown
Exit For
End If
Next y
'
'===