複数条件が一致で別シートに転記【エクセル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 · ベストアンサー

こういうのは「複数条件による抜き出し問題」だ。
関数で出来ればおなじみのやり方で良いのだが、既に出ているように式が長く複雑で、初心者には何をやって居るかわからない式になる。毎度週に数回このタイプの質問が出て、同じようなタイプの答えになる。Ｇｏｏｇｌｅででも「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点だけ追加で教えてください。
「注文データ」からデータを抜くと、転記先からも消えるようにしたいです。

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

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

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

回答No.2

mu2011

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

配達表のＡ列に時刻を入力しておく事としています。
データシート範囲は２００行としていますのでデータ量に合わせて調整して下さい。
配達表の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の相談でした。

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

回答No.1

merlionXX

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

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さんから頂いたものとで頑張ります。

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