処理すべき公報データをそのまま修正すると条件を変えて処理するときに毎回公報データをコピーする必要があり、面倒である。
また、処理項目以外を除いて処理したいこともある。
そこで、元の公報データをコピーし、このコピーした公報データを処理するようにしている。
マクロは以下のとおり。
Sub 対象公報コピー()
'
'対象公報をコピーし、公報番号以外のノイズ行を削除する
'
'変数を宣言
Dim dKOHO As Variant
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 Integer, flg As Integer
'シート名称設定
SHEETNAME01 = "対象公報"
SHEETNAME02 = "公報コピー"
'
'クリア
Worksheets(SHEETNAME02).Activate
Cells.Select
Selection.Delete Shift:=xlUp
'
'================
'対象公報をコピーする
'================
'処理範囲の行列数を取得
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)).Copy
Sheets(SHEETNAME02).Select
Cells(1, 1).Select
ActiveSheet.Paste
'
'========================
'公報番号以外のデータがあれば削除する
'========================
'公報種別名を配列に読込む
dKOHO = Array("WO", "特開", "特表", "実開", "実登", "特許", "特公", "実公")
'MsgBoxd dKOHO(7)
'処理範囲の行列数を取得
Sheets(SHEETNAME02).Select
Cells(1, 1).Select
ActiveCell.CurrentRegion.Select
NY2 = Selection.Rows.Count
NX2 = Selection.Columns.Count
'公報番号以外をクリア
For y = 2 To NY2
flg = 0
For k = 0 To 7
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(NY2, NX2)).Sort Key1:=Cells(1, 1), Order1:=xlAscending, Header:= _
xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
SortMethod:=xlPinYin
'
'データがなければ終了する
'処理範囲の行列数を取得
Sheets(SHEETNAME02).Select
Cells(1, 1).Select
ActiveCell.CurrentRegion.Select
NY2 = Selection.Rows.Count
NX2 = Selection.Columns.Count
If NY2 = 1 Then
MsgBox "データがありません。対象公報の有無、処理コード指定表の設定(全コードが設定されてるいるかなど)を確認してください。"
End
End If
'
'==============
Cells(1, 1).Select
'MsgBox "終了しました"
'
End Sub