EXCELで２シート間で同一品番チェック

質問

いろいろと過去の事例等を確認したのですが、わからないため質問させてください。
１つのEXCELファイルのAシート（旧）とBシート（新）の品番を比較し、
同一品番があれば、その横にあるAシートの日付をBシートにコピーしたい。

Aシート　　　　　　　　　　　　Bシート　　　　　　　　　　Bシート　　　
A列　　　B列 　　　　　　A列　　　B列　　　　　　　A列　　B列
日付　　品番　　　　 　　日付　　品番　　　　　　　 日付　　品番　
8/23 XXXX　　　　　　　　　　XXXX　　　　→　　 8/23 XXXX
8/25 YYYY　　　　　　　　　　ZZZZ　　　　　　　　 8/30 ZZZZ
8/30 ZZZZ　　　　　　　　　　AAAA　　　　　　　　　　　　　AAAA

と言うようなVBAを作りたいのですが、上手く行きません。
Aシート及びBシートの品番の最後は空白です。

何度やっても上手く行きませんので、どなたかご教授願いたく思います。

以上、よろしくお願い致します。

回答No.1

kmetu · ベストアンサー

With Sheets("Bシート")
For i = 2 To .Range("B" & Rows.Count).End(xlUp).Row
With Sheets("Aシート").Range("B2:B" & Sheets("Aシート").Range("B" & Rows.Count).End(xlUp).Row)
Set c = .Find(Sheets("Bシート").Range("B" & i).Value, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
Sheets("Bシート").Range("A" & i) = c.Offset(0, -1)
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
Next i
End With

でいかがでしょう。2003のHELP(find)を参考にしたものです。

お礼

早速の回答ありがとうございます。
ご教授頂いたソースと式で対応できると思います。
ありがとうございました。

回答No.2

kmetu

VBAでなくて式でやるのでしたら、BシートのA２に

=IF(ISNA(INDEX(Aシート!A:B,MATCH(Bシート!B2,Aシート!B:B,0),1)),"",INDEX(Aシート!A:B,MATCH(Bシート!B2,Aシート!B:B,0),1))

として必要なだけ下にコピーしてください。

お礼

VBAと式両方の回答ありがとうござました。