C01.公報データのコピー

処理すべき公報データをそのまま修正すると条件を変えて処理するときに毎回公報データをコピーする必要があり、面倒である。

また、処理項目以外を除いて処理したいこともある。

そこで、元の公報データをコピーし、このコピーした公報データを処理するようにしている。

マクロは以下のとおり。

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