ExcelVBAでデータ不一致のものの抽出

単純なものにしたいので教えてください。
Sheet1「元データ」　　　　　　　　　　　　　　
　　　A　　　B　　 　C　　　D　　
コード　商品　　店名　　納入日　　
1 0001 みかん　 A店　　3/1　
5 0360 メロン　　D店
6 かき　　　P店
7 0312 キウイ　　D店
9 0333 くり　C店
Sheet2「最新データ」
　　A　　　B　　 　C　　　D
コード　商品　　店名　　納入日　
1 0001 みかん　 A店　　3/1
4 0311 いちご B店　　3/10
6 0250
8 0312 キウイ　　　
とあった時に元データのA列の番号と最新データの番号を見て同じ物があったら、元データに最新データの内容をうつし込み、一致しなかったらチェックデータへうつしこむというデータがあります。
Dim Sh1 As Worksheet
Dim Sh2 As Worksheet
Dim Sh3 As Worksheet
Dim myR As Range
Dim N_D As Long
Dim i As Long
Set Sh1 = Worksheets("元データ")
Set Sh2 = Worksheets("チェックデータ")
Set Sh3 = Worksheets("最新データ")
With Sh1
For i = 5 To .Range("A65536").End(xlUp).Row
N_D = .Range("E" & i).Value
Set myR = Sh3.Range("A:A").Find(What:=N_D, LookIn:=xlValues, _
MatchCase:=False)
If Not myR Is Nothing Then
myR.Offset(, 2).Resize(, 3).Copy _
Destination:=.Range("B" & i & ":D" & i)
Else
addR_No = Sh2.Range("A65536").End(xlUp).Row + 1
.Range("A" & i & ":D" & i).Copy _
Destination:=Sh2.Range("A" & addR_No & ":D" & addR_No)
End If
Next
End With
ここで、データが一致した場合は無視して、一致しなかったときだけチェックデータに内容を書き込むとする場合はどのように修正すればよいのでしょうか？あと、チェックデータのあたまに
コード　商品　　店名　　納入日　
という言葉を入れたいのですが、どのように書き込むのでしょうか？

No.1 ベストアンサー 回答者： noname#29107 回答日時： 2004/12/15 09:58

＞ここで、データが一致した場合は無視して、一致しなかったときだけチェックデータに

＞内容を書き込むとする場合はどのように修正すればよいのでしょうか？
If Not myR Is Nothing Then
　　myR.Offset(, 2).Resize(, 3).Copy _
　　Destination:=.Range("B" & i & ":D" & i)
Else
　　addR_No = Sh2.Range("A65536").End(xlUp).Row + 1
　　.Range("A" & i & ":D" & i).Copy _
　　Destination:=Sh2.Range("A" & addR_No & ":D" & addR_No)
End If

を以下のように変更

If myR Is Nothing Then
　　addR_No = Sh2.Range("A65536").End(xlUp).Row + 1
　　.Range("A" & i & ":D" & i).Copy _
　　Destination:=Sh2.Range("A" & addR_No & ":D" & addR_No)
End If

＞あと、チェックデータのあたまに
＞コード　商品　　店名　　納入日　
＞という言葉を入れたいのですが、どのように書き込むのでしょうか？
始めにコード　商品　　店名　　納入日を入力しておけば、特にプログラムで設定する必要は無いと思いますが、あえてやるなら

Set Sh3 = Worksheets("最新データ")　の直後の行に
If Sh3.Range("A1").Value <> "コード" Then
　　Sh3.Rows(1).Insert
　　Sh3.Range("A1").Value = "コード"
　　Sh3.Range("B1").Value = "商品"
　　Sh3.Range("C1").Value = "店名"
　　Sh3.Range("D1").Value = "納入日"
End If

あと余計なお世話でしょうが、元データと最新データの比較という場合、最新データが元データにあるかチェックするのが普通だと思いますが、今のマクロでは元データが最新データに存在するかどうかのチェックになっていますが、これが実現したいことなのでしょうか？

この回答へのお礼

なるほど！Notをとることで普通にIｆ文になるからすすめれるわけですね。
通常元データを中心にして考えるんでしょうが、今回は毎月最新データを中心にして考えて元データを作るというにしてます。
実際のデータは大量にあるので、大分進んできて楽しくなってきました。また細かい所で質問させていただきますのでよろしくお願いします。

お礼日時：2004/12/15 19:45

No.2 回答者： imogasi 回答日時： 2004/12/15 10:38

何がしたいか２つのケースが考えられす。

（１）元データの中で売れてない（最新データにない）明細
（２）最新データにあるが、元データにない明細
例えば、マスタになくて、販売データにある明細
（１）らしいのですが曖昧。
下記は（１）でやって見ました。
Sub test01()
Dim Sh1 As Worksheet
Dim Sh2 As Worksheet
Dim Sh3 As Worksheet
Dim myR As Range
Dim N_D As Long
Dim i As Long
'---------
Set Sh1 = Worksheets("元データ")
Set Sh2 = Worksheets("チェックデータ")
Set Sh3 = Worksheets("最新データ")
'---------チェックデータ・シートに項目見だしを入れる
Sh2.Cells(1, "A") = "コード"
Sh2.Cells(1, "B") = "商品"
Sh2.Cells(1, "C") = "店名"
Sh2.Cells(1, "D") = "納入日"
'-----初期値設定
j = 2 'チェックデータ・シートに第２行目から
'---------元データの各行に付いて繰り返し
For i = 2 To Sh1.Range("A65536").End(xlUp).Row
N_D = Sh1.Range("A" & i).Value
Set myR = Sh3.Range("A:A").Find(What:=N_D, LookIn:=xlValues, _
MatchCase:=False)
If myR Is Nothing Then
'-----見つからなかった場合
Sh2.Cells(j, "A") = Sh1.Cells(i, "A")
Sh2.Cells(j, "B") = Sh1.Cells(i, "B")
Sh2.Cells(j, "C") = Sh1.Cells(i, "C")
Sh2.Cells(j, "D") = Sh1.Cells(i, "D")
j = j + 1 '次に書く行をポイント
Else
'見つかった場合何もしない
End If
Next
End Sub
質問のコードに誤り？の箇所があるようで、修正しました。出来るだけ原型を尊重しましたが、私の好みのスタイルになっている箇所があります。
（データ例）元データＡ１：Ｄ９
コード商品店名納入日
1みかんA店1月3日
360メロンD店
312かきP店
313キウイD店
333くりC店
344リンゴＦ店
322バナナD店
318ももA店
最新データＡ１：Ｄ７
コード商品店名納入日
1みかんA店1月3日
311いちごB店10月3日
250
313キウイＦ店
360メロンＧ店
344リンゴＣ店
（結果）チェックデータＡ１：Ｄ５
コード商品店名納入日
312かきP店
333くりC店
322バナナD店
318ももA店

この回答へのお礼

とっても参考になりました。
結局のところ（１）も（２）も両方やりたかったりします。色々なシートに書き写すので。。
でも、とりあえず一つのことを教えてもらえば、あとは自分で考えようと思ってこのような曖昧な質問になってしまい、申し訳ありません。
大分進んできて楽しくなってきています。
また細かい質問いれますのでよろしくお願いします。

お礼日時：2004/12/15 19:49