エクセルでのマッチング（ちょっと複雑）

質問

色々エクセルでのマッチングのページを見ましたが自分の状況に該当するのがなかったので質問させて頂きます。
エクセルでのデータが２つあります。
Sheet1
Ａ列→注文ＮＯ
Ｂ列→金額
Ｃ列→製造番号
Ｄ列→金額
Ｅ列→商品名
Sheet2
Ａ列→注文ＮＯ
Ｂ列→金額
Ｃ列→品名
Ｄ列→数量
Ｅ列→単価

の２つのシートがあります。２つのシートを比較して、 Ａ列の注文ＮＯが一致してたら、Sheet1,Sheet2のＧ列に”注文ＮＯが一致してます”と記載します。
さらに注文ＮＯも一致し、同じ行の金額も一致したら、”金額も一致してます”とＨ列に記載します。
できましたら、 注文ＮＯと金額が一致した物に関してSheet2のＦ列にSheet1の製造番号を記載するようなプログラムを作りたいと思います。 シート１は２千件。シート２も同じく２千件くらいで、データはランダムに入ってます。

↓に私が調べた結果、注文ＮＯだけをキーにしてマッチングさせて、動くプログラムがありますした。ロジックとしてはシンプルで素晴らしいのですが、そっから先自分で組むことができませんでした。
２つをキーにする場合や別シートから一致したデータの一部を持ってくるものは探してもわかりませんでした。
http://www.okweb.ne.jp/kotaeru.php3?q=507722

質問された方と違い、データは人が入れていることもあり、間違いがある可能性があり２つ以上をキーにして、どこの製造番号の物かわかるようなプログラムをできる方教えて頂けませんでしょうか？
ちょっと複雑ですのでここに出すべきか迷いましたが、プログラムの組める方、お願い致します。
エクセルで関数を使う方法ではなく、毎月チェックしないといけませんので、マクロで一発！で考えています。
宜しくお願い致します。

回答No.5

grumpy_the_dwarf

マクロを使うほどのことはないですよ。

sheet2のF列とG列には、それぞれSheet1からvlookup()関数を使って
製造番号と金額を持ってきます。vlookup()関数の最後のパラメータ
をFALSEにするのを忘れないで下さい。発見できなかったときは-1で
も返すようにしておきましょう。

これでG列には、製造番号がマッチするときには金額が、マッチしな
い時には-1が入りましたので、書式を"注文ＮＯが一致してます
";"";""とします。H列にはB列とG列を比較して"金額も一致していま
す"を表示させます。
F列は書式を#;"";""としておけば-1のときに表示されませんし、条件
書式でH列が"金額も一致しています"でない場合に文字色を白にして
おけば見えませんね。

回答No.4

hamha

>ＶＢＡのシートでどこにこのコードをかけば良いですか？

標準モジュールに記述します。

ツール→マクロ→新しいマクロの記録　で、適当にキー操作して保存後、
下記の箇所にコピーしてみてください。

Option Explicit

Sub Macro1()
'
' Macro1 Macro
' マクロ記録日 : 2003/5/22 ユーザー名 : aaaaa
'

'

ここにコピーする

End Sub

こちらでは、下記環境にて正常に動作していますが。。。
使用環境
１）Win2000 SP1
Excel2002(Office XP)
Pentium1GHz memory256MB

２）Win XP
Excel2002(Office XP)
Pentium1.4GHz memory512MB

計算方法は「手動」にしたほうがいいかもしれません。

お礼

ありがとうございます。明日会社で試してみます。私が作ったのでも正常動作しますので、自分のヨリ早く動いてくれたら嬉しいと思います。

回答No.3

taisuke555

少数データでのデバッグしかしていませんので、不具合箇所が見つかるかもしれませんが、
Findメソッド（ワークシート関数とは違います）を使った方法です。
For文で検索するより早く検索できると思います。（２０００件位だとどんなもんでしょう？）

Sub test()
　　Dim i As Long
　　Dim rn As Range

　　With Worksheets("Sheet2")
　　　　For i = 2 To .Range("A400").End(xlUp).Row
　　　　　　'[Sheet1]の"注文Ｎｏ"を検索
　　　　　　Set rn = Worksheets("Sheet1").Range("A:A").Find(what:=.Cells(i, 1))
　　　　　　If (Not rn Is Nothing) Then
　　　　　　　　fAddress = rn.Address '最初に一致したセルのアドレス
　　　　　　　　Do
　　　　　　　　　　.Cells(i, "G") = "注文ＮＯが一致してます"
　　　　　　　　　　rn.Offset(0, 6) = "注文ＮＯが一致してます"
　　　　　　　　　　If (rn.Offset(0, 1) = .Cells(i, "B")) Then
　　　　　　　　　　　　.Cells(i, "H") = "金額も一致しています"
　　　　　　　　　　　　.Cells(i, "F") = rn.Offset(0, 2)
　　　　　　　　　　End If
　　　　　　　　　　'次の同一"注文番号"を検索
　　　　　　　　　　Set rn = Worksheets("Sheet1").Range("A:A").FindNext(rn)
　　　　　　　　Loop While (Not rn Is Nothing And rn.Address <> fAddress)
　　　　　　End If
　　　　Next i
　　End With
End Sub

質問のセルと＃１の補足に書かれたセルが違うような気がしますが、
質問のセルで作ってあります。
一度試してみてください。

回答No.2

AQUALINE

わたしもマクロ初心者ですが、あなたがお書きになった参考URLを見て、下記のように書換えてみました。
一応動くようです。いかがでしょうか？

Sub CHECKTEST()
Dim 最終行1, 最終行2 As Integer
Dim 行1, 行2 As Integer
最終行1 = Worksheets(1).Range("A1").CurrentRegion.Rows.Count
最終行2 = Worksheets(2).Range("A1").CurrentRegion.Rows.Count

For 行2 = 2 To 最終行2
For 行1 = 2 To 最終行1

If Worksheets(2).Range("A" & 行2) = Worksheets(1).Range("A" & 行1) Then
Worksheets(1).Range("G" & 行1) = "注文Noが一致"
Worksheets(2).Range("G" & 行2) = "注文Noが一致"
If Worksheets(2).Range("B" & 行2) = Worksheets(1).Range("B" & 行1) Then
Worksheets(1).Range("H" & 行1) = "金額も一致"
Worksheets(2).Range("H" & 行2) = "金額も一致"
Worksheets(2).Range("I" & 行2) = Worksheets(1).Range("C" & 行1)
End If
End If

Next 行1
Next 行2
End Sub

回答No.1

hamha

こんな感じでどうですか？
このマクロを実行するだけです。
現在は2500件までの設定ですが、必要であれば「2500」の値を変えてください。

Sheet1.Select

Sheet1.Range("G2") = _
"=IF(COUNTIF(Sheet2!A:A,A2)=1,""注文ＮＯが一致してます"","""")"

Sheet1.Range("H2") = _
"=IF(AND(COUNTIF(Sheet2!I:I,I2)=1,G2<>""""),""金額も一致してます"","""")"

Sheet1.Range("I2") = "=IF(A2<>"""",A2&""-""&B2,"""")"

Range("G2:I2").Select
Selection.Copy
Range("G3:I2500").Select
ActiveSheet.Paste
Application.CutCopyMode = False

Range("G1").Select

'-------------------------------------------------------------------------

Sheet2.Select

Sheet2.Range("F1") = "製造番号"

Sheet2.Range("F2") = _
"=IF(COUNTIF(Sheet1!I:I,I2)=1,VLOOKUP(A2,Sheet1!A:C,3,0),"""")"

Sheet2.Range("G2") = _
"=IF(COUNTIF(Sheet1!A:A,A2)=1,""注文ＮＯが一致してます"","""")"

Sheet2.Range("H2") = _
"=IF(AND(COUNTIF(Sheet1!I:I,I2)=1,G2<>""""),""金額も一致してます"","""")"

Sheet2.Range("I2") = "=IF(A2<>"""",A2&""-""&B2,"""")"

Range("F2:I2").Select
Selection.Copy
Range("F3:I2500").Select
ActiveSheet.Paste
Application.CutCopyMode = False

Range("G1").Select

補足

ありがとうございます。しかし、エラーが発生します・・・。

ＶＢＡのシートでどこにこのコードをかけば良いですか？標準モジュールにではないみたいなので、シートの方に記入しました。そして走らせたら、結果がでたらめでした？？hamha様のプログラムのミスか、私が何かミスっているのかわかりませんが、シート１とシート２に、同じ値がはいっていてもうまくマッチングされてません。あと、製造番号が記入されておりませんで、注文番号が記載されており、値が入ったアクティブなセルをダブルクリックすると再計算をしているのか、エクセルが処理をしてしまって、手がつけれません。ロジック的には素晴らしいと思うので、利用させて頂きたいのですが、いかんせんレベルが低いので意味がさっぱり？宜しければ手直しして、教えて頂けませんでしょうか？

自分でプログラムを初めて組んでみましたが、↓で動きます。結構時間がかかって余分な所が多い気がしまいますが・・・。

Option Explicit

Sub 支払通知書()
Dim 最終行1, 最終行2 As Integer
Dim 行1, 行2 As Integer
最終行1 = Worksheets(1).Range("A400").End(xlUp).Row
最終行2 = Worksheets(2).Range("A400").End(xlUp).Row
Worksheets(1).Activate

'マクロ実行画面を表示しない
Application.ScreenUpdating = False
For 行2 = 2 To 最終行2
For 行1 = 2 To 最終行1
'注文ＮＯが一致してた時製造番号を表示させるプログラム
If Worksheets(2).Range("A" & 行2) = Range("A" & 行1) Then
Range("K" & 行1) = Worksheets(2).Range("C" & 行2)
End If
Next 行1
Next 行2

'注文ＮＯが一致してた時表示するプログラム
Application.ScreenUpdating = False
For 行2 = 2 To 最終行2
For 行1 = 2 To 最終行1
If Worksheets(2).Range("A" & 行2) = Range("A" & 行1) Then
Range("J" & 行1) = "注文ＮＯは一致してます"
行1 = 最終行1
End If
Next 行1
Next 行2

'注文ＮＯが一致しかつ金額が一致した時表示させるプログラム
Application.ScreenUpdating = False
For 行2 = 2 To 最終行2
For 行1 = 2 To 最終行1
If Worksheets(2).Range("A" & 行2) = Range("A" & 行1) And Worksheets(2).Range("B" & 行2) = Range("B" & 行1) Then
Range("I" & 行1) = "金額も一致してます"
行1 = 最終行1
End If
Next 行1
Next 行2

End Sub