excel2000マクロ記述方法

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

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

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

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

　　　　

No.1 ベストアンサー 回答者： nishi6 回答日時： 2002/05/16 00:26

質問の表がよく分からず、以下のようにしています。

　２つのシートとも１行目は項目名、
　ファイル名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シートの項目名を入れたいのですが
よろしくお願いします。

補足日時：2002/05/16 18:38