本来の処理を行なう前に、以下の前処理を行ないます。
・公報番号以外のノイズ行を削除する。
・重複を公報を除去する。
・データの形式を標準化する。
・発行年を付加する。
サンプルは以下のとおり。
Sub 公報データ前処理()
'
'公報番号以外のノイズ行を削除し、重複を公報を除去し、発行年を付加する
'
'変数を宣言
Dim dKOHO As Variant
Dim SHEETNAME01 As String
Dim NY1 As Long, NX1 As Integer
Dim y As Long, x As Integer, k As Integer, flg As Integer
Dim nclm1 As Integer, nkh As Integer
'シート名称設定
SHEETNAME01 = "公報コピー"
'
'カラム位置を指定
nclm1 = 3 '発行日
'
'========================
'公報番号以外のデータがあれば削除する
'========================
'公報種別名を配列に読込む
dKOHO = Array("WO", "特開", "特表", "実開", "実登", "特許", "特公", "実公")
nkh = 8
'MsgBoxd dKOHO(7)
'処理範囲の行列数を取得
Sheets(SHEETNAME01).Select
Cells(1, 1).Select
ActiveCell.CurrentRegion.Select
NY1 = Selection.Rows.Count
NX1 = Selection.Columns.Count
'公報番号以外をクリア
For y = 2 To NY1
flg = 0
For k = 0 To nkh - 1
If Left(Cells(y, 1), 2) = dKOHO(k) Then flg = 1
Next k
If Len(Cells(y, 1)) > 13 Then flg = 0
If flg = 0 Then Rows(y).Clear
Next y
'公報番号でソートして空白行を除去
Range(Cells(1, 1), Cells(NY1, NX1)).Sort Key1:=Cells(1, 1), Order1:=xlAscending, Header:= _
xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
SortMethod:=xlPinYin
'
'=================
'対象公報の重複を除去する
'=================
'処理範囲の行列数を取得
Sheets(SHEETNAME01).Select
Cells(1, 1).Select
ActiveCell.CurrentRegion.Select
NY1 = Selection.Rows.Count
NX1 = Selection.Columns.Count
'公報番号でソート
Range(Cells(1, 1), Cells(NY1, NX1)).Sort Key1:=Cells(1, 1), Order1:=xlAscending, Header:= _
xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
SortMethod:=xlPinYin
'次行の公報番号が同じならば当該行をクリア
For y = 2 To NY1
If Cells(y, 1) = Cells(y + 1, 1) Then Rows(y).Clear
Next y
'ソートして空白行を削除
Range(Cells(1, 1), Cells(NY1, NX1)).Sort Key1:=Cells(1, 1), Order1:=xlAscending, Header:= _
xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
SortMethod:=xlPinYin
'
'===========
' 発行年を追加する
'===========
Sheets(SHEETNAME01).Select
Cells(1, 1).Select
ActiveCell.CurrentRegion.Select
NY1 = Selection.Rows.Count
NX1 = Selection.Columns.Count
' 発行年の欄を追加
Cells(1, NX1 + 1) = "発行年"
'年データを抽出
For y = 2 To NY1
Cells(y, NX1 + 1) = Year(Cells(y, nclm1))
Next y
'文字列表記に変更
Columns(NX1 + 1).Select
Selection.NumberFormatLocal = "G/標準"
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
'
'==============
Cells(1, 1).Select
'MsgBox "終了しました"
'
End Sub
上記以外の前処理として次のものがある。
・ＦＩデータの形式を標準形に修正する。マクロはB10Aを参照してください。
・ＦＴデータの空白を除去したり、10桁コードを9桁に制限する。
・指定したコードを含む公報データを削除する。