Exel VBA 別シートから該当データを取得する

質問

お世話になります。 エクセルVBAで質問です。

以下の日付表というシートがあります
A列に日付、B列に商品番号が入力してあります。C列のコードは未入力です。
A列　　　　 B列　　　　　C列　　　　　　
日付　　　　対象商品番号　　コード
2020/6/1　　U-1325-L　　
2020/6/2　　R-134256
2020/6/3　　L-456632
・
・
・
2020/6/30　 W-724789

また、一覧表という別のシートには、A列に商品番号と、B列からコードが何百件も入力されています。
（1行目に限っては、A1だけ商品番号の項目でB列からは日付です）

A列　　　　 B列　　　　　C列　　　　　D列　 AE列
商品番号　　2020/6/1　　2020/6/2　　2020/6/3・・・・ 2020/6/30
R-134256　　123123　　　456456　　　741741　・・・・ 753753
U-1325-L　　789879　　　963963　　　852852　・・・・ 951951
・
・
・

やりたいことは
日付表のC列のコード欄に、一覧表から商品番号と日付が一致するコードを貼り付けしたいのです。

現状、目視で全入力しているので、マクロで一度に処理を希望します。
または、マッチしたら一覧表側のコードセルにマークつける方法でもかまいません。

と、言ってみたものの、Google検索しても、どうやって調べればいいのかが、わかりませんでした。
マクロの基本事項は本で学びましたが、条件が複数になってくるとよく理解できません。
どうぞよろしくお願いします。

回答No.1

kkkkkm · ベストアンサー

関数でもいけそうですが
C2に
=IFERROR(INDEX(一覧表!$A$1:$AE$31,MATCH(日付表!B5,一覧表!$A:$A,0),MATCH(日付表!A5,一覧表!$1:$1,0)),"該当なし")
下にコピーで

VBAでしたら(上記の式を当てはめてもいけると思いますがFindを使いました)
日付の検索になりますのでヒットしない場合は
Sh1.Cells(i, "A").Value
を
DateValue(Sh1.Cells(i, "A").Value)
とかにしたりして探ってください。この場合日付以外のデータがあるとエラーになりますのでIsdate()で日付(数値)かどうか確認が必要です。

Sub Test()
Dim Sh1 As Worksheet, Sh2 As Worksheet
Dim FrR As Range, FrC As Range
Dim LastRow As Long, mRow As Long, mColumn As Long
Dim i As Long, flg As Boolean

Set Sh1 = Sheets("日付表")
Set Sh2 = Sheets("一覧表")
LastRow = Sh1.Cells(Rows.Count, "A").End(xlUp).Row

For i = 2 To LastRow
flg = True
Set FrR = Sh2.Range("1:1").Find(What:=Sh1.Cells(i, "A").Value, LookIn:=xlValues, lookat:=xlWhole)
If Not FrR Is Nothing Then
mColumn = FrR.Column
Else
flg = False '"見つかりません"
End If
Set FrC = Sh2.Range("A:A").Find(What:=Sh1.Cells(i, "B").Value, LookIn:=xlValues, lookat:=xlWhole)
If Not FrC Is Nothing Then
mRow = FrC.Row
Else
flg = False '"見つかりません"
End If
If flg = True Then
Sh1.Cells(i, "C").Value = Sh2.Cells(mRow, mColumn).Value
Else
Sh1.Cells(i, "C").Value = "該当なし"
End If
Next
Set Sh1 = Nothing
Set Sh2 = Nothing
End Sub

お礼

大変助かります。
思い通りになりました。
ありがとうございました！

回答No.3

imogasi

データ例　Sheet1 A1:C4
C列が求める結果です。当初は空白。
日付 対象商品番号 コード
2020/6/1 U-1325-L 789879
2020/6/2 R-134256 456456
2020/6/3 L-456632 642122
ーーー
Sheet2　A1:F４
商品番号 2020/6/1 2020/6/2 2020/6/3 2020/6/4 2020/6/5
R-134256 123123 456456 741741 741723 753753
U-1325-L 789879 963963 852852 851674 951951
L-456632 653123 645231 642122 611216 683211
ーー
コード　標準モジュールに
Sub test01()
Set Sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
'---
lr = Sh1.Range("A100000").End(xlUp).Row 'Sh1の最終行番号数
MsgBox "Sh1の最下番号" & lr
For i = 2 To lr 'Sheet1の各行に対し、繰り返し処理
x = Sh1.Cells(i, "B") 'Sh1のB列の商品番号
MsgBox "Sh1から取得　商品番号" & x
r = sh2.Range("A:A").Find(what:=x).Row 'Sh2のA列のどの行にあるか
MsgBox "Sh2で　商品番号見つかった行" & r
'－－－
y = Sh1.Cells(i, "A") 'Sh1のA列の日付け取得
MsgBox "Sh1から取得　日付け" & y
c = sh2.Range("a1:z1").Find(what:=y).Column
MsgBox "Sh2で日付けが見つかった列" & c
Z = sh2.Cells(r, c) 'Sh1で其れらの行、列の交差セルデータ
Sh1.Cells(i, "C") = Z 'Sh1のC列へセット
Next i
End Sub
---
テストが終わればMsgboxの行はすべて削除して実行。
商品番号、日付がSheet2で存在しないという前例は考えてない。

回答No.2

kkkkkm

No1の一部訂正です。

式のコピー元を間違えて5行目の式をコピペしたのでB5とA5をB2とA2に直してください。
=IFERROR(INDEX(一覧表!$A$1:$AE$31,MATCH(日付表!B5,一覧表!$A:$A,0),MATCH(日付表!A5,一覧表!$1:$1,0)),"該当なし")
↑これを以下↓のように
=IFERROR(INDEX(一覧表!$A$1:$AE$31,MATCH(日付表!B2,一覧表!$A:$A,0),MATCH(日付表!A2,一覧表!$1:$1,0)),"該当なし")