excel2000マクロ記述方法

質問

抽出条件方法のマクロ記述

1つのファイルのシートの中にデータがあります。
例ファイル名a.xlsシート名マスター
　　　　Ｂ列　Ｃ列　　　Ｄ列　　　　Ｅ列
項目名　倉庫　 翻訳　 ソート 　非表示項目
　　　　A057　レオナ工場　 1
　　　　A870　セ新港 　　 2　　　　Y
　　　　A887　セ日向　 　 3

もう1つのファイル
例ファイル名B.xlsシート名WORK
　　　　A列　　　Ｂ列　　　ｃ列　　　　d列　　　　E列　
　　連結コード 　品名 　倉庫 出荷１ 　加工１　
AA 0G120 0G120 　A870 0 0 0
AA 0H120 0H120 　A057 0 0 0
AA 0S0100 0S010 　A887 0 0 0

抽出条件方法
シート名WORKのデータの中のＣ列と、シート名マスターのＢ列の倉庫を参照して
非表示項目のＹが入っていない、倉庫と同じデータをシート名WORKのデータを抽出したい
場合のマクロ記述の方法を教えてください。よろしくお願いします。
（抽出表示方法）
AA 0H120 0H120 　A057 0 0 0
AA 0S0100 0S010 　A887 0 0 0

回答No.1

nishi6 · ベストアンサー

質問の表がよく分からず、以下のようにしています。
　２つのシートとも１行目は項目名、
　ファイル名B.xlsシート名WORKの　　Ｃ列（倉庫）　と
　ファイル名a.xlsシート名マスター　Ｂ列（倉庫）　を照合して、
　　２つの項目内容が完全に一致した場合、
　　　マスターＥ列（非表示項目）に『Y』(半角Y)が入っていなければ、
　　　シート名WORKのＡ列からＦ列を抽出して、シート名PICKに書いています。
　　　　　どう見ても私には6列分に見えたので6列取り出しています。
　　　　　（『PICK』は勝手につけたシート名です。状況に合うように変更して下さい）

Book名やシート名の『　"a.xls"、"マスター"、"b.xls"、"WORK"、"PICK"　』については、状況に合うよう変更して下さい。
ブックやシートの定義部分が長くなってしまいました、実際プログラムらしいのはFindくらいでしょうか。
この例でいえば、Book"b.xls"に標準モジュールを挿入し、下記コードをコピーして貼り付けます。ご参考に。（当方、Excel2000です）

'抽出するシートの標準モジュールに貼り付け
Sub 抽出()
　　Dim bkMS As Workbook　　　　'マスターのBookを定義
　　Dim wsMS As Worksheet　　　 'マスターのシートを定義
　　　　Set bkMS = Workbooks("a.xls")
　　　　Set wsMS = bkMS.Worksheets("マスター")
　　Dim rgFind As Range　　　　 '検索範囲を定義
　　　　Set rgFind = wsMS.Range("B2:B" & wsMS.Range("B65536").End(xlUp).Row)

　　'ワーク　　Bookとシートの定義
　　Dim bkWK As Workbook　　　　'データのBookを定義
　　Dim wsWK As Worksheet　　　 'データのシートを定義
　　Dim wsPK As Worksheet　　　 'データの抽出結果の出力シートを定義
　　　　Set bkWK = Workbooks("b.xls")
　　　　Set wsWK = bkWK.Worksheets("WORK")
　　　　Set wsPK = bkWK.Worksheets("PICK")

　　Dim rgLook As Range　　　　 '検索で見つかったセル(マスタのB列)
　　Dim rwWK As Long　　　　　　'データ行カウンタ
　　Dim rwMS As Long　　　　　　'マスタ行カウンタ
　　Dim rwPK As Long　　　　　　'抽出行カウンタ
　　Dim KMK As Integer　　　　　'出力項目カウンタ
　　Const KMKnum = 6　　　　　　'出力項目数
　　rwWK = 2: rwMS = 2: rwPK = 0

　　'出力シートをクリアする
　　wsPK.Cells.ClearContents

　　'データシートのC列がなくなるまで続ける
　　While wsWK.Cells(rwWK, 3) <> ""
　　　　'マスタを調べる
　　　　Set rgLook = rgFind.Find(What:=wsWK.Cells(rwWK, 3).Text, LookAt:=xlWhole)
　　　　　　'見つかったら
　　　　　　If Not rgLook Is Nothing Then
　　　　　　　　'『非表示項目』が『Y』でなかったら抽出
　　　　　　　　If rgLook.Offset(0, 3) <> "Y" Then
　　　　　　　　　　rwPK = rwPK + 1
　　　　　　　　　　For KMK = 1 To KMKnum
　　　　　　　　　　　　wsPK.Cells(rwPK, KMK) = wsWK.Cells(rwWK, KMK)
　　　　　　　　　　Next
　　　　　　　　End If
　　　　　　End If

　　　　rwWK = rwWK + 1
　　Wend

　　wsPK.Select
　　MsgBox "抽出が終了しました。"
End Sub

補足

ありがとうございました
実際やってみたのですが少し教えてください。
シート名workは列がＡ列からＲ列の１８列あります。
ファイル名a.xlsシート名マスター　Ｂ列（倉庫）　は３行目から
データが入ってます。
マスターＥ列（非表示項目）に『Y』(半角Y)が入っている。
上記を踏まえて 下記の所を修正して動かしました。
　Const KMKnum = 18　　　　'出力項目数
　Set rgFind = wsMS.Range("B3:B" & wsMS.Range("B65536").End(xlUp).Row)

PICKのシートに抽出されてきたのですが、マスターＥ列（非表示項目）に『Y』(半角Y)が入って
いる倉庫も出てきました。
後どこを修正すれば良いのでしょうか教えてください。
後　rwWK = 2: rwMS = 2: rwPK = 0 ここの意味がわかりません。
PICKのシートに抽出する行は２行目から出したいのですが。1行目はworkシートの項目名を入れたいのですが
よろしくお願いします。