エクセル２０００マクロ検索方法

質問

Ａのファイル　a.xls シート名 aaa
Ｂのファイル　b.xls シート名 bbb

Ａのファイルに下記のデータベースがあります。
　　Ａ列　Ｂ列
　　0001　100
　　0002　200
　　0004 300

Ｂのファイルに下記のデータベースがあります。
　　Ａ列　Ｂ列
　　0001　300
　　0002　200

抽出条件方法
ＡのファイルとＢのファイルのＡ列を参照して違うものだけを、Ａのファイルから
別のファイルに取り出す方法をマクロでの記述方法を教えてください。

別のファイルに取り出すデータは、下記の通リです。
　　Ａ列　Ｂ列
　　0004 300

以上よろしくお願いします。

回答No.2

imogasi · ベストアンサー

booka.xlsとbookb.xlsを\My Documentsに作らせてもらった。アウトプットファイルはbookbのsheet2に作らせてもらった。データのファイル（Ｂｏｏｋ）が違うため勝手が違い多少苦労しました。booka.xlsのＶＢＥ画面に下記test01をコーディングしてください。Ｔｈｉｓｗｏｒｋｂｏｏｋを使って切りぬけましたが、もっと良い答えが出ることを期待しつつ。小数例でテスト済です。結果も別ファイルにしたかったが、夜もふけて来て・・・。
Sub test01()
'----最下行数を得る
Workbooks.Open "c:\My Documents\bookb.xls"
a = ThisWorkbook.Worksheets("sheet1").Range("a2").CurrentRegion.Rows.Count
b = Worksheets("sheet1").Range("a2").CurrentRegion.Rows.Count
'-----ポインターを初期設定
i = 2 '２行目からデータ。BookaのＳｈｅｅｔ1の行ポインター
j = 2 '２行目からデータ。BookbのＳｈｅｅｔ1の行ポインター
k = 2 '２行目からデータ。BookbのＳｈｅｅｔ2の行ポインター
'----
p01:
'-----終わり判定
If i > a + 1 Then GoTo p02
If j > b + 1 Then GoTo p03
'----Ｓｈｅｅｔ１のキーとＳｈｅｅｔ２のキーの比較をする
'----一致する時なにもしないで、
Comp:
If ThisWorkbook.Worksheets("sheet1").Cells(i, 1) = Worksheets("sheet1").Cells(j, 1) Then GoTo Equal
If ThisWorkbook.Worksheets("sheet1").Cells(i, 1) > Worksheets("sheet1").Cells(j, 1) Then GoTo High
If ThisWorkbook.Worksheets("sheet1").Cells(i, 1) < Worksheets("sheet1").Cells(j, 1) Then GoTo Low
'--------マスターとトランザクションあり。何もしない。
Equal:
i = i + 1 'マスターとトランザクションを進める
j = j + 1
GoTo p01
'-------- マスターなし。新規トランザクション・新顔
'------本問題ではこのケース無しとしていると見える。
High:
j = j + 1
GoTo p01
'--------トランザクションなし
'-------本問題では、このケースをＳｈｅｅｔ2へ書き出す
Low:
MsgBox ThisWorkbook.Worksheets("sheet1").Cells(i, 2)
ThisWorkbook.Worksheets("sheet2").Cells(k, 1) = ThisWorkbook.Worksheets("sheet1").Cells(i, 1)
ThisWorkbook.Worksheets("sheet2").Cells(k, 2) = ThisWorkbook.Worksheets("sheet1").Cells(i, 2)
i = i + 1 'マスターを進める
k = k + 1
GoTo p01
'-------マスターの終わり
p02:
For l = i To a
ThisWorkbook.Worksheets("sheet2").Cells(k, 1) = Worksheets("sheet1").Cells(l, 1)
ThisWorkbook.Worksheets("sheet2").Cells(k, 2) = Worksheets("sheet1").Cells(l, 2)
k = k + 1
Next l
ThisWorkbook.Close
End
'------本問題では起こり得ないと仮定
p03:
End
End Sub