エクセル重複チェックをしながら追記

質問

エクセル2003

「Sheet5」のデータを「Sheet6」に重複チェックをしながら追記していきたいです。

「Sheet5」に他のソフトから出力したデータがあります。
「Sheet6」には履歴を残すために出力したデータを追記していきます。
そこで、重複チェックをしながら追記したいです。
重複チェックは【請求先コード】【日付】の２つでしたいです。
私が作成したものは【請求先コード】のみのチェックです。
日付のデータ型を「Date」にして、どう記述すればよいのか分からずに質問しました。
よろしくお願い致します。

「Sheet5」１行目は見出し
A列・・・・・・・・・・・・・B列・・・・・・・・・・・C列
請求先コード　｜　請求先名　｜ 　日付
1000 A社 2011/1/20
1010 B社 2011/1/20
1012 C社 2011/1/20

「Sheet6」１行目は見出し
A列・・・・・・・・・・・・・B列・・・・・・・・・・・C列
請求先コード　｜　請求先名　｜ 　日付
1000 A社 2011/1/10
1000 A社 2011/1/20
1010 B社 2011/1/10
1010 B社 2011/1/20
1012 C社 2011/1/10
1012 C社 2011/1/20
1015 D社 2011/1/10
1010 E社 2011/1/10

Sub test1()

Dim ws1 As Worksheet, ws2 As Worksheet
Dim x As Long, y As Long, z As Long, i As Long

Set ws1 = Sheets("Sheet5")
z = Range("A1").End(xlDown).Row
Set ws2 = Sheets("Sheet6")
x = ws2.Cells(Rows.Count, "A").End(xlUp).Row + 1

For y = 1 To z
If ws1.Cells(y, "A").Value = "" Then Exit For
Next

ws1.Cells(2, "A").Resize(y - 1, z).Copy
ws2.Cells(x, "A").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False

With Worksheets("Sheet6")

'A列とC列を基準に昇順で並び替えます
Sheets("Sheet6").Select
Range("A1").Select
Range("A:C").Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range( _
"C2"), Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase _
:=False, Orientation:=xlTopToBottom, SortMethod:=xlPinYin, DataOption1:= _
xlSortNormal, DataOption2:=xlSortNormal

'請求先コードにして重複チェック
For i = ActiveSheet.Range("A65536").End(xlUp).Row To 2 Step -1
With Cells(i, "A")
If .Value = .Offset(-1).Value Then
.EntireRow.Delete
End If
End With
Next
End With

End Sub

回答No.2

fumufumu_2006 · ベストアンサー

Dictionaryオブジェクトで重複チェックをしながら追記しました。

Sub sample()
Dim dic As Object
Dim r6 As Long
Dim r5 As Long
Dim key As String
'Sheet6のデータを取得
Set dic = CreateObject("Scripting.Dictionary")
r6 = 2 'Sheet6の注目行の初期値
Do While Sheets("Sheet6").Cells(r6, "A").Value <> ""
key = Sheets("Sheet6").Cells(r6, "A").Value & vbCrLf & Sheets("Sheet6").Cells(r6, "C").Value
If Not dic.Exists(key) Then
dic.Add key, 1
End If
r6 = r6 + 1
Loop
'Sheet5のデータをチェックしながらSheet5に追加
r5 = 2 'Sheet5の注目行の初期値
Do While Sheets("Sheet5").Cells(r5, "A").Value <> ""
key = Sheets("Sheet5").Cells(r5, "A").Value & vbCrLf & Sheets("Sheet5").Cells(r5, "C").Value
If Not dic.Exists(key) Then
dic.Add key, 1
Sheets("Sheet6").Cells(r6, "A").Resize(1, 3).Value = Sheets("Sheet5").Cells(r5, "A").Resize(1, 3).Value
r6 = r6 + 1
End If
r5 = r5 + 1
Loop
'Sheet6を並び替えるなら
Sheets("Sheet6").Columns("A:C").Sort Key1:=Sheets("Sheet6").Range("A2"), Order1:=xlAscending, Key2:=Sheets("Sheet6").Range("C2"), Order2:=xlAscending, Header:=xlYes
End Sub

お礼

fumufumu_2006　様、

わざわざプログラムを作成して頂き、ありがとうございます。
２つのキーを基準にしての重複チェックは完成しました。
処理も早くて驚きました。
ネットでサンプルを見ながら作成していました。
まだ、システムは完成していませんが、調べながら構築していきます。
ありがとうございました。

回答No.1

imogasi

表題にはVBAの質問である旨明記されたい。
自分のコードを読ませるのも良いが、プログラムのロジック（とは下記（１）以下のような大筋の処理法）そのものを、考える必要がある。コードより前の重要な段階の課題のはず。これによってコードが簡単にも複雑にもなり、デバッグの難易を左右する。これは経験や長時間施行後のひらめきが必要。
エクセルなど、データベースでないソフトでは（A列）AND（C列）で今考えているデータ（会社＋日付）のペアで同じものが存在するかどうかは、一遍に検出しにくい。
（１）２項目を結合したデータを新しい列に作る。文字列の方が良かろう。
その際項目内で有効文字桁数が違う場合があるので各項目で、定桁性にして作るべき場合が多い。
例えばすべての場合で会社は１０桁（株式会社　東西商事△）＋日付は１０桁（例　2011/03/02）
もちろん表現は統一する必要は在る。（株）と株式会社ではバラバラ、日付で西暦と和暦などバラバラは論外）
（２）前もってプログラムの配列にデータに存在する会社＋日付の組み合わせを作る（エクセルのセルも１種もメモリの利用なので（１）と似ている）それをチェックのとき索引する。
（３）ソート法
データをソートするとその組み合わせは近隣にまとまる。
そのまとまりの中以外には存在しないことが断言できるので、２つを１つづつチェックできる。
会社＋日付でソートする。
同一会社の（最初のデータ行は会社のFindメソッドで検出できる）塊をみて、その塊の中にその日付があるかチェックすれば良い。
ソートはシステムの処理に乗っかるので、ユーザーの未熟なコードミスが避けられる。
むしろプログラムの中に含めづ、手操作で準備作業にしてしまうことが出来る。

お礼

imogasi 様

回答をありがとうございます。
ネットでサンプルコードを組み合わせながら作成していました。
大筋の処理法・経験や長時間施行後・定桁性など基本的なアドバイスを細かく書いて頂きありがとうございます。
重複チェックをしながら追記は完成しました。
まだ、システムは未完成ですが、調べながら頑張ります。
ありがとうございました。