複数条件が一致で別シートに転記【エクセルVBA】

エクセルでセルの条件が複数一致したら別シートに転記される方法をお教えください。
シートを２枚用意して、配達日ごとに一覧化したいのです。
事前に用意したシート（配達表）の“配達”と“配達時間”が一致したら
その方の名前と注文個数を右側に反映したいのですが・・・

注文データが多すぎて困っています。
宜しくお願いします。

■シート名：注文データ
　　　Ａ　　　 Ｂ　　　 Ｃ　　　 Ｄ　　　 Ｅ
------------------------------------------------
１　しめい　　対応　　 配達日　 　時間　　 個数
------------------------------------------------
２　たけだ　　配達　　6/20（月）　13:00　　２個
３　みうら　　配達　　6/18（土）　14:00　　４個
４　らもす　　郵送　　6/20（月）　 ― 　　５個
５　いはら　　配達　　6/20（月）　14:30　　８個
６　かつや　　配達　　6/20（月）　15:00　　６個
７　みうら　　郵送　　6/20（月） 　―　 　４個

■シート名：配達表
　　　　Ａ　　　　 Ｂ　　　　Ｃ
------------------------------------
１　　配達　　　6/20（月）
------------------------------------
２　　12:00
３　　12:30
４　　13:00
５　　13:30
６　　14:30
７　　15:00
８　　15:30
９　　16:00

マクロを実行すると・・・
↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓

■シート名：配達表
　　　　Ａ　　　　 Ｂ　　　　Ｃ
------------------------------------
１　　配達　　　6/20（月）
------------------------------------
２　　12:00　
３　　12:30
４　　13:00 　　 たけだ　 　２個
５　　13:30
６　　14:00 　 　みうら　 　４個
６　　14:30 　　いはら　 　８個
７　　15:00 　　かつや　 　６個
８　　15:30
９　　16:00

No.3 ベストアンサー 回答者： imogasi 回答日時： 2011/06/20 14:46

こういうのは「複数条件による抜き出し問題」だ。

関数で出来ればおなじみのやり方で良いのだが、既に出ているように式が長く複雑で、初心者には何をやって居るかわからない式になる。毎度週に数回このタイプの質問が出て、同じようなタイプの答えになる。Ｇｏｏｇｌｅででも「imogasi方式」で照会すれば、過去の沢山の例と回答（そのタイプも）が出てくる。
ーー
まず初心者や急ぐ場合はデーターフィルターフィルタオプションの設定で済ませられないか勉強すべきだ。
ーー
本来、こういう仕事の関連のエクセル表は、ＶＢＡを勉強してそれを使うべきと思う（既に回答も出ているようだ）
関数で抜き出し問題や表の組み換えは、ＶＢＡで無いと、天下りの長い式をコピペで使うだけになる。
ーー
私が紹介している「imogasi方式」では、Ｓｈｅｅｔ２に時刻の所定の行に出す問題なので複雑になりすぎる。
ーー
ＶＢＡでやってみる。
例データ
しめい対応配達日時間個数
たけだ配達6月20日13:00２個
みうら配達6月18日14:00４個
らもす郵送6月20日ーー５個
いはら配達6月20日14:30８個
かつや配達6月20日15:00６個
みうら郵送6月20日ーー４個
（注意）
「ーー」セルは空白とする
「月日」列は、エクセルの年月日を入れておくこと（日付シリアル値（わかりますか））　文字列では不可
6/20（月）　の様な表示は、表示形式の設定でやること（エクセルの常識）　 m/d（aaa)
時間の列も時刻シリアル値で入れてあるとする。文字列では不可
ーー
コード
標準モジュールに
Sub test01()
Dim sh1, sh2
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
d = sh1.Range("A65536").End(xlUp).Row
On Error Resume Next
For i = 2 To d
'--条件をかけて選別
If sh1.Cells(i, "B") = "配達" And sh1.Cells(i, "C") = sh2.Range("B1") And _
sh1.Cells(i, "D") <> "" Then
t = sh1.Cells(i, "D")
'---Ｓｈｅｅｔ２で時刻行を探す
For r = 2 To 30
If sh1.Cells(i, "D") = sh2.Cells(r, "A") Then Exit For
Next r
'--該当行の値をＳｈｅｅｔ２の時刻該当行セット
Sheet2.Cells(r, "B") = sh1.Cells(i, "A")
Sheet2.Cells(r, "C") = sh1.Cells(i, "E")
End If
Next i
End Sub
ーー
実行結果
Ｓｈｅｅｔ２
配達6月20日
12:00
12:30
13:00たけだ２個
13:30
14:00
14:30いはら８個
15:00かつや６個
15:30
16:00
・・・・・・

この回答への補足

回答ありがとうございます。

1点だけ追加で教えてください。
「注文データ」からデータを抜くと、転記先からも消えるようにしたいです。

キャンセルもありまして・・・

転記先セルをいったん全て白紙にしてから、
転記を実行すると言えば分りますでしょうか。

ご指導宜しくお願いします。

補足日時：2011/06/26 16:46

No.2 回答者： mu2011 回答日時： 2011/06/20 11:51

この程度ならワークシート関数でも対応できるが如何でしょうか。

配達表のＡ列に時刻を入力しておく事としています。
データシート範囲は２００行としていますのでデータ量に合わせて調整して下さい。
配達表のB2に=IF(COUNTIF(Sheet1!$D:$D,$A2),INDEX(Sheet1!A:A,SUMPRODUCT(("配達"=Sheet1!$B$2:$B$200)*($A2=Sheet1!$D$2:$D$200)*ROW(Sheet1!$A$2:$A$200))),"")

C2に=IF(COUNTIF(Sheet1!$D:$D,$A2),INDEX(Sheet1!E:E,SUMPRODUCT(("配達"=Sheet1!$B$2:$B$200)*($A2=Sheet1!$D$2:$D$200)*ROW(Sheet1!$A$2:$A$200))),"")
を設定、下方向にコピーして下さい。

この回答へのお礼

回答ありがとうございました。
関数が多くデータ容量が大きくなった為、VBAの相談でした。

ご説明不足で失礼しました。

お礼日時：2011/06/26 16:44

No.1 回答者： merlionXX 回答日時： 2011/06/20 11:38

このような感じでしょうか？

日付けも時間も一致しなければいけないのですよね？
配達時間が同一となるデータは存在しないのですね？

Sub test01()
　　Dim ws(1)
　　Dim myC As Range, tg As Range
　　Set ws(0) = Sheets("注文データ")
　　Set ws(1) = Sheets("配達表")
　　Set myC = ws(0).Range("A2")
　　
　　Do Until myC.Value = "" '注文データA列にデータがある限り
　　　　If myC.Offset(, 2).Value = ws(1).Range("B1").Value Then '日付が一致すれば
　　　　　　Set tg = ws(1).Columns("A:A").Find(What:=myC.Offset(, 3).Text, LookAt:=xlPart) '配達表A列の時間検索
　　　　　　If Not tg Is Nothing Then '一致すれば
　　　　　　　　tg.Offset(, 1).Value = myC.Value '転記
　　　　　　　　tg.Offset(, 2).Value = myC.Offset(, 4).Value '転記
　　　　　　End If
　　　　End If
　　　　Set myC = myC.Offset(1) '1行下へ
　　Loop '繰り返し
End Sub

この回答へのお礼

早々にご回答ありがとうございました。
imogasiさんから頂いたものとで頑張ります。

上記補足にも書いた消去方法が分かれば教えて頂けますでしょうか。

お礼日時：2011/06/26 16:49