B07B.出願人別集計

動向分析では、企業がどのような技術に注力しているか分析することも重要である。

そこで、出願人別の集計表を作成するが、基本的には縦項目に出願人を設定するだけであり、コード別集計と大きな違いは無い。

ただし、出願人名称が変更されていたり、異なる表記が混在する場合には、そのまま集計すると発行件数の順位が異なってしまい、間違った分析を行なう恐れがある。

そこで、出願人別の集計では出願人名称を統一してから処理するようにしている。

また、出願人別の発明者人口や、新規参入企業も分析項目として重要である。

また、出願人別や発明者別の発行件数を集計する場合には持ち分で処理している。

例えば、４社で共同出願したものは持ち分を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

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:=";"

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

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

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

'===