EXCELを使ってデータ抽出の方法

質問

二つのシートから、品番の違うものを抽出したいのです。たとえば：
シート１に　品番
A-654565-005-2
B-789456-003-4
C-258369-001-3
E-357689-009-9
D-147258-004-4
d-147258-005-5
usp-3690258-006-8
usp-3690258-006-8
シート２に　品番
A-654565-005-2
B-789456-003-4
C-258369-001-3
d-147258-005-5
があります。シート１とシート２と比べると、「usp-3690258-006-8」のような品番がないのです。そのようなもの（シート２にないもの）を全部シート３に抽出したいのです。やり方を教えてください。よろしくお願いします。

回答No.5

imogasi · ベストアンサー

＃４です。
●私の場合Ｓｈｅｅｔ２の品番について、Ｓｈｅｅｔ１の品番テーブルに無いもの（Ｓｈｅｅｔ１を主体にしてＳｈｅｅｔ２をチェックした）を、Ｓｈｅｅｔ３に書き出すようにしました。質問のＳｈｅｅｔ１の例示の数が、Ｓｈｅｅｔ２の例示の数より多かったものでつい思いこみました。質問では逆でした。
関数式Ｓｈｅｅｔ１！とＳｈｅｅｔ２！を相互に入れ替えてみてください。
●それに品番だけのテーブルはおかしいと思い、、ＦＡＬＳＥの前を２にしましたが、１（検索列自身。品番列）に改めてみてください。
今のところそれ以外は誤りが発見できません。

お礼

大変ありがとうございました。VLOOKUPを使いましたが、なぜかうまくいきませんでした。でも、IFとISERRORを使いました。いいヒントを与えてくれてありがとうございます。
私は二列を使って
=ISERROR(MATCH(Sheet2!A7,Sheet1!$A:$A,0))
と=IF(A1=TRUE,Sheet2!A7,"")という式を使いました。

回答No.4

imogasi

Sheet1の品番がユニーク（重複なし）なら、
シート３のＡ１に
=IF(ISERROR(VLOOKUP(Sheet2!A1,Sheet1!$A$1:$B$4,2,FALSE)),Sheet2!A1,"")といれ、下に複写してださい。
Ｂ１には
=IF(ISERROR(VLOOKUP(Sheet2!A1,Sheet1!$A$1:$B$4,2,FALSE)),Sheet2!B1,"")
といれ、Ｃ１、Ｄ１・・列以右も同様です。
Ｓｈｅｅｔ１の品番をテーブル（表）としてＳｈｅｅｔ２のＡ列品番１つ1つを探し、見つからない時は、その行のＡ，Ｂ、Ｃ・・のセルの値をＳｈｅｅｔ３に持ってきます。
後はＳｈｅｅｔ３で値のみの複写を自己自身に行い
式を消し、ソートすればデータは下に沈殿しますので、上部のスペース部分を削除してください。
テスト不足ですが、上手く行くといいですが。
実のところＶＢＡでやりたい！

お礼

ありがとうございます。
教えていただいた方法で試しましたが、なぜかうまくいきませんでした。よければもう一度詳しく教えていただけないのでしょうか。よろしくお願いします。

回答No.3

fever

Sheet1の方に関数：MATCHを用いる手もあります。

Sheet1のB2に
=MATCH(A2,Sheet2!$A:$A,0)
と入力し、あとはフィルハンドルでリストの最後までコピーします。
Sheet2にない品番には『#N/A』が表示されますので、オートフィルタで『#N/A』のみを表示させます。
Ａ列をコピーして、Sheet3にペーストします。

補足

教えていただいたとおり、シート２にない品番が『#N/A』と表示しました。しかし、『#N/A』と表示した品番はどうやってシート３に抽出するのですか。教えてください。ありがとうございます。

回答No.2

noname#4564

この手の処理はデータベースを使うに限ります。
下記の要領で行けると思いますが、どうでしょう。

# Jetでは文字列の比較がTextCompareなので、大文字小文字の区別が問題ですが・・・。

Public Sub PickUp()
Dim Engine As Object
Dim db As Object
Dim rs As Object
Dim strSql As String
Dim FullDbName As String

Set Engine = CreateObject("DAO.DBEngine.36")
With Application.ActiveWorkbook
Set db = Engine.OpenDatabase(.Path & "\" & .Name, False, False, "Excel 8.0")
End With

FullDbName = "[Excel 8.0;Database=" & db.Name & "]"

strSql = "SELECT DISTINCT Table1.品番"
strSql = strSql & " FROM"
strSql = strSql & " " & FullDbName & ".[Sheet1$] Table1"
strSql = strSql & " LEFT JOIN"
strSql = strSql & " " & FullDbName & ".[Sheet2$] Table2"
strSql = strSql & " ON"
strSql = strSql & " Table1.品番 = Table2.品番"
strSql = strSql & " WHERE"
strSql = strSql & " Table2.品番"
strSql = strSql & " Is Null"
strSql = strSql & " ORDER BY Table1.品番"
Set rs = db.OpenRecordset(strSql, 4) 'dbOpenSnapshot

Application.Worksheets("Sheet3").Cells(1, 1).CopyFromRecordset rs

db.Close
Set rs = Nothing
Set db = Nothing
End Sub

お礼

答えていただき、ありがとうございます。

回答No.1

kojitti

これでどうでしょうか？

Sub Main()
k = 1
For i = 1 To 65536
If Worksheets(1).Range("A1")(i) = "" Then Exit For
For j = 1 To 65536
If Worksheets(2).Range("A1")(j) = Worksheets(1).Range("A1")(i) Then Exit For
If Worksheets(2).Range("A1")(j) = "" Or j = 65536 Then
Worksheets(3).Range("A1")(k).Formula = Worksheets(1).Range("A1")(i)
k = k + 1
Exit For
End If
Next j
Next i
End Sub

お礼

早速答えていただき、本当にありがとうございます。
プロではないので、なかなかむずかしいと思います。