二つのリストを比べて同じものがある際に抽出するVBA

いつもお世話になっております。
EXCEL2007を使用をしておりますので、アドバイスよろしくお願い致します。

SHEET1⇒大元のデータ
SHEET2⇒貼り付けるためのデータ

SHEET2のA列には抽出したい項目があります。
そこでSHEET1のC列とSHEET2のA列が一緒の時、
SHEET2のB列とC列にデータを抽出できないでしょうか。

SHEET1
（A列）　　　　 （B列）　　　　（C列）
種類　　　　　 産地　　　 入荷予定
ミルクチョコレート フランス 3月(品川)
ビターチョコレート イタリア 1月(横浜)
ビターチョコレート フランス 12月(立川)
ミルクチョコレート ベルギー 1月(横浜)
ミルクチョコレート ベルギー 3月(立川)

SHEET2
（A列）　　　　　 （B列）　　　　　　　（C列）
入荷月　　　　　　　種類　　　　 産地
1月(横浜) 　　 ビターチョコレート イタリア
1月(横浜)　　 ミルクチョコレート ベルギー
3月(品川) 　　ミルクチョコレート フランス

ちなみに実際のデータはもっと複雑で行数も多くフィルタで行うと固まり、
自分でマクロを作成しても上手く抽出されませんでした。。。
皆様のお力添えどうぞよろしくお願い致します。

Sub 抽出()
Application.ScreenUpdating = False

Sheets("SHEET2").Select
Dim i As Long, x As Long, LstR As Long
LstR = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To LstR
x = 2
If Sheets("SHEET2").Cells(i, 1).Value <> "" Then
Sheets("SHEET1").Select
Dim n As Long, LstRow As Long
LstRow = Cells(Rows.Count, 1).End(xlUp).Row
For n = 2 To LstRow
If Sheets("SHEET1").Cells(n, 3).Value = Sheets("SHEET2").Cells(i, 2).Value Then
Sheets("SHEET2").Cells(x, 2).Value = Sheets("SHEET1").Cells(n, 1).Value
Sheets("SHEET2").Cells(x, 3).Value = Sheets("SHEET1").Cells(n, 2).Value
x = x + 1
End If
Next n
End If
Next i
Application.ScreenUpdating = True
End Sub

質問者からの補足コメント

• お二方ともアドバイスありがとうございました。
  私の書き方が悪く混乱させてしまったのですが
  SHEET2のA列には項目があり、例えば
  A2＝1月(横浜)
  A3＝3月(品川)
  A4＝3月(自由が丘)
  ・
  ・
  と項目が続いています。
  
  そこでSHEET1のC列がA2の”1月(横浜) ”となっているものをSHEET2のB列の2行目から抽出して貼付け（別シートに抽出でもOK）
  次に同じくA3の”3月(品川)”になっているものをB列の最終行の一行下に貼り付け。
  次にA4の”3月(自由が丘)”となっているものをまたB列の最終行の一行下に貼り付け。
  A5、A6・・・と続いていく、といった感じにしたいです。
  
  申し訳ありませんが、よろしくお願い致します。

    補足日時：2018/12/17 15:19

• お世話になります。
  SHEET1のC列は重複しますが、B列は重複しません。
  (むしろC列は同じものがけっこうあるので、Sheet2のA列の項目と同じだったときに全て抽出したいです)
  また必ずB列がちがうため同じ内容のものはないので、重複のチェックは要らないです。
  
  重複チェックではなく、Sheet1のC列でSheet 2のA2と同じものがあれば全て抽出、次にA3と同じだったら全て抽出、次にA4,,,といった感じです。

  No.5の回答に寄せられた補足コメントです。 補足日時：2018/12/17 17:36

• シート２のA列の値は必ず重複しないです。
  簡単なのですね、これ。。。
  皆さんすごい。。。

  No.7の回答に寄せられた補足コメントです。 補足日時：2018/12/17 17:38

• Sheet3で全然大丈夫です！
  いま色々見ているのですがよくわからなくて
  お助けいただけると嬉しいです。

  No.8の回答に寄せられた補足コメントです。 補足日時：2018/12/17 18:05

No.2 回答者： nouble1 回答日時： 2018/12/17 12:43

此方には、

お求めの、
「重複しない物だけを集める事」
其のものが　掲げられていますが、

ご覧には　なれませんでしたか？

念の為　抜粋、
さて登録するデータですが、連想配列では「キー」と「値」の二つが必要です。今回のケースでは「名前」データしかありません。「名前」を「キー」にするとして、「値」には何を登録したらいいのでしょう。
何でもいいんです。ここで重要なことは重複しない「キー」の集まりを作ることです。「値」はすべて空欄でもいいですし「キー」と同じ「名前」を登録してもかまいません。コードにすると次のようになります。
Sub Sample1()
Dim Dic, i As Long, buf As String
Set Dic = CreateObject("Scripting.Dictionary")
For i = 2 To 8 ''セルA2からセルA8までを処理する
buf = Cells(i, 1).Value ''セルの値を変数bufに格納する
If Not Dic.Exists(buf) Then ''まだ登録されていなかったら…
Dic.Add buf, buf ''セルの値を連想配列に登録する
End If
Next i
MsgBox Dic.Count
Set Dic = Nothing
End Sub
Existsメソッドは、指定したキーが、連想配列内に存在していたときTrueを返し、存在しないときはFalseを返します。先に例として紹介した「県庁所在地」の連想配列でしたら、Exists("千葉県")はTrueで、Exists("静岡県")はFalseとなります。Addメソッドは、連想配列に新しい「キー」と「値」のセットを追加します。最後のCountプロパティは、連想配列内のデータ組数を返します。

せっかく重複しないリストを作成しても、ただ個数を確認するだけでは実用的とは言えませんね。作成したリストを別のセルに出力するには次のようにします。
Existsメソッドは、指定したキーが、連想配列内に存在していたときTrueを返し、存在しないときはFalseを返します。先に例として紹介した「県庁所在地」の連想配列でしたら、Exists("千葉県")はTrueで、Exists("静岡県")はFalseとなります。Addメソッドは、連想配列に新しい「キー」と「値」のセットを追加します。最後のCountプロパティは、連想配列内のデータ組数を返します。

せっかく重複しないリストを作成しても、ただ個数を確認するだけでは実用的とは言えませんね。作成したリストを別のセルに出力するには次のようにします。

Sub Sample2()
Dim Dic, i As Long, buf As String, Keys
Set Dic = CreateObject("Scripting.Dictionary")
For i = 2 To 8
buf = Cells(i, 1).Value
If Not Dic.Exists(buf) Then
Dic.Add buf, buf
End If
Next i
''出力
Keys = Dic.Keys
For i = 0 To Dic.Count - 1
Cells(i + 2, 2) = Keys(i)
Next i
Set Dic = Nothing
End Sub

http://officetanaka.net/excel/vba/tips/tips80.htm

No.1 回答者： nouble1 回答日時： 2018/12/17 11:07

VBAで無いと　駄目なのですか？

後、Excelでは、
オブジェクトの　タッチ数が、
尤も、
速度に　跳ね返ります。


VBと違い、v'BAでは、
オブジェクトへの　一括アクセスが、
出来るものが、
沢山　用意されています、

又、
ディクショナリー等、
便利なものも　あります。


v'Bの　書き方を、
其のまま　適応すると、
遅くなりますよ？


因みに、
ディクショナリーへの　登録には、
同一キー　発生時に、
エラーで、
告知して　貰えますから、

キー登録方法を　工夫すれば、
エラーフックするだけで、
簡単に　記載できますよ。


主なキーを、
文字数固定長に、当てはめ、
連結するとかで、
十分に　思えますよ。


尚、ディクショナリーは、
遅いという　評価を、
下している　サイトも、
確かに　見かけますが、

後日、本人が、
訂正しているものも　見受けますよ。

此等を、
ご参照　頂けますか？
http://officetanaka.net/excel/vba/tips/tips80.htm

https://tonari-it.com/excel-vba-dictionary-object/

https://www.sejuku.net/blog/29736

お役に　立てて居たなら、
幸いです。

この回答へのお礼

アドバイスありがとうございます。
ただ、やりたいことがちょっと違っていたり
プレミアム会員じゃないと先が読めなかったり
解決することが出来ませんでした。

重複したものを見つけたいのではなく
A列に記載された項目と同じものを抽出したかったので(単純に私の理解が悪いだけかもしれません)

お礼日時：2018/12/17 12:06