EXCELの２つのシートの照合処理マクロについて

質問

マクロが得意でなく下記の処理が可能かご教授いただければと
お願いします。

・シートＡに自社の発注済みデータ
・シートＢに発注先から送られてきた受注データがあります。

シートＡの発注番号コードとシートＢの受注番号コードが一致するので
これを基にそれぞれのシートにある数量、単価、金額を照合し
一致しないレコードのみシートＣにコピーさせる。
という流れなのですが、

・それぞれのシートのコード、数量、単価、金額は別々の列にあります。

現在関数とオートフィルターで処理しているのですが効率が悪いため
改善するよう指示されて困っております。
よろしくお願いします。

回答No.7

ushi2015 · ベストアンサー

こんにちは
順当なループ処理のコードが出てますので、別の方法で。
シートＡの発注番号コードが、
シートＢの受注番号コードに全て存在し必ず一致するという前提で、

Sub test()
　　Dim shA As Worksheet
　　Dim shB As Worksheet
　　Dim shC As Worksheet
　　Dim s As Range
　　Dim t As Range
　　Dim u As Range
　　Dim v As Range

　　'↓実際の項目名に変更する
　　Const A_発注番号項目名 = "発注番号"
　　Const B_受注番号項目名 = "受注番号"

　　'↓実際の列番に変更する
　　Const A_金額列番 = 6
　　Const B_金額列番 = 8

　　Application.ScreenUpdating = False

　　Set shA = Worksheets("A")
　　Set shB = Worksheets("B")
　　Set shC = Worksheets("C")

　　shC.UsedRange.ClearContents

　　Set s = shA.Range("A1").CurrentRegion.Rows(1).Find(A_発注番号項目名, , , xlWhole)
　　Set t = shB.Range("A1").CurrentRegion.Rows(1).Find(B_受注番号項目名, , , xlWhole)
　　t = A_発注番号項目名

　　shA.Range("A1").CurrentRegion.Copy shC.Range("A1")

　　Set u = shC.Range("A1").End(xlToRight).Offset(, 3)
　　shB.Range("A1").CurrentRegion.Rows(1).Copy u

　　Set v = shA.Range("A1").CurrentRegion.Columns(s.Column)
　　shB.Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
　　　　CriteriaRange:=v, CopyToRange:=u.CurrentRegion, _
　　　　Unique:=False

　　shC.Range("A1").CurrentRegion.Sort key1:=shC.Cells(1, s.Column), Header:=xlYes
　　u.CurrentRegion.Sort key1:=u.Offset(, t.Column - 1), Header:=xlYes

　　t = B_受注番号項目名

　　u.Offset(, -2) = "判定"

　　With shC.Range("A1").CurrentRegion
　　　　With u.Offset(1, -2).Resize(.Rows.Count - 1)
　　　　　　.FormulaR1C1 = "=RC" & A_金額列番 & "=RC" & B_金額列番 + u.Column - 1
　　　　　　.Value = .Value
　　　　End With
　　End With

　　With shC
　　　　.Range("A1").CurrentRegion.AutoFilter _
　　　　　　Field:=u.Offset(, -2).Column, Criteria1:="TRUE"
　　　　.AutoFilter.Range.Offset(1).Delete Shift:=xlUp
　　　　.AutoFilterMode = False
　　　　u.Offset(, -2).EntireColumn.ClearContents
　　End With

　　u.CurrentRegion.ClearContents

　　Application.ScreenUpdating = True

End Sub

データ量が多いと遅いかも。
テストブックで試して下さい。
コードの中をクリックしてから、Ｆ8キーを押すとステップ実行されるので
シートＣの変化が順を追って確認出来ます。

お礼

ありがとうございます。
シートCに項目の行があればと思ってありましたところ、
ご教授頂けまして感謝いたします。

回答No.6

Prome_Lin

回答No.5です。

For j = 2 To 4
If s1.Cells(i, j).Value <> s2.Cells(f.Row, j).Value Then
r = r + 1
s3.Cells(r, 1).Value = s1.Cells(i, 1).Value
Exit For
End If
Next j

の部分が、判断をしている部分ですが、今は、列「A」がコードとしているので、列「B」、「C」、「D」をすべて調べていますが、金額だけでしたら、

For j = 2 To 4
Exit For
Next j

の３行を削除。

If s1.Cells(i, j).Value <> s2.Cells(f.Row, j).Value Then

を、

If s1.Cells(i, 6).Value <> s2.Cells(f.Row, 8).Value Then

で、左端のシートの「６」列目、２番目のシートの「８」列目、となります。
（質問者は、「行目」と言っておられますが、「列」です。今回の場合は、明らかに間違いに気づくので、いいのですが、エクセルの話をされるときは、行と列を間違うと、話がひどくややこしくなります。「横」が「行」、「縦」は「列」です。気をつけられた方がいいです。）

これだけです。

お礼

今回は大変ありがとうございました。
参考にさせて頂いて、勉強させて頂きます。

回答No.5

Prome_Lin

１つの考え方です（具体的な状況が、完全には分からないので）。

目的のエクセルのファイルを開いて、「Alt＋F11」（「Alt」（「オルト」と読みます）キーを押しながら、「F11」を押す）で、「Visual Basic」の画面を出して、メニューの「挿入」から、「標準モジュール」を選択すると、画面の右側が白くなるので、その白くなった部分に、以下のマクロをコピー＆ペーストしてください。

次に、エクセルの画面にもどって、「F12」（「名前を付けて保存」）で、ファイル名が表示されている１行下の行、右端の「∨」をクリックして、「Excel マクロ有効ブック」を選択して保存してください。

これで、元のファイルも残っていますので、安心して実行できます。

実行は、「Visual Basic」の画面にもどって「F5」で実行できます。

Sub Test()
Set s1 = Worksheets(1)
Set s2 = Worksheets(2)
Set s3 = Worksheets(3)
r = 0
For i = 2 To s1.Cells(Rows.Count, 1).End(xlUp).Row
Set f = s2.Range("A:A").Find(s1.Cells(i, 1).Value)
For j = 2 To 4
If s1.Cells(i, j).Value <> s2.Cells(f.Row, j).Value Then
r = r + 1
s3.Cells(r, 1).Value = s1.Cells(i, 1).Value
Exit For
End If
Next j
Next i
End Sub

マクロの説明をしますので、質問者の環境に合わせるとか、参考にしてください。

Set s1 = Worksheets(1)
Set s2 = Worksheets(2)
Set s3 = Worksheets(3)

一番左端のシートを「s1」、２番目のシートを「s2」、３番目を「s3」にセット。

r = 0

行カウント用変数。

For i = 2 To s1.Cells(Rows.Count, 1).End(xlUp).Row

左端のシートの列「A」を２行目から最終行まで処理。

Set f = s2.Range("A:A").Find(s1.Cells(i, 1).Value)

列「A」（「コード」を想定）のデータで、２番目のシートを検索。

For j = 2 To 4

２列目から４列目までを処理。

If s1.Cells(i, j).Value <> s2.Cells(f.Row, j).Value Then

もし、値のことなるものが１つでもあれば、

r = r + 1

３番目のシートに書き出すための行カウント。

s3.Cells(r, 1).Value = s1.Cells(i, 1).Value

３番目のシートに、異なった「コード」のみを書き込み。

以上です。

たとえば、４行目のコードが「1234」だとします。

Set f = s2.Range("A:A").Find(s1.Cells(i, 1).Value)

すると、「i」の値が「４」のときに、「s1.Cells(i, 1).Value」の値は「1234」で、２番目のシートの列「A」の中から検索しています。

If s1.Cells(i, j).Value <> s2.Cells(f.Row, j).Value Then

この中の、「f.Row」が、２番目のシートにあった、同じコードが何行目か、というのが入っています。

それから、手作業になりますが、「ボタン」をマクロに関連付ける方法があります。

やり方を示したサイトはいっぱいありますから、画面上の邪魔にならないところに、ボタンを作って、それをクリックしたら、マクロが実行される、という形にしておかれてはどうでしょうか？

ボタンの作成と、そのボタンにマクロを関連付ける方法は、文字では非常に分かりにくいのですが、調べると、どのサイトも、実際の画面で図説されているので、そのとおりにやれば、できるとおもいます。

補足

大変わかりやすい解説までして頂き、非常に参考になりました。

誠に厚かましくて申し訳ありませんが、
もう一つご教授頂けないでしょうか？

コードで参照して、金額列の数値のみ照合するものとして
シートAで６行目が金額、シートBでは８行目が金額すると
照合の処理はどうすれば良いのでしょうか？

よろしくお願いします。

回答No.4

imogasi

件数はどれくらいなのか、書いてないのは、コンピュター処理の経験が少ない証拠。
少なければ（数千件以下ぐらいか）関数などで処理できる方法もある。
操作をVBAに置き換える方法（例　フィルター法など）もある。
しかしVBAで処理を考えると
（１）発注番号コード（と受注番号コードは同じものとして）で、FindメソッドでSheet1の発注番号コードをもとにSheet2を検索してがいとう該当行を見つけて、処理をする（Sheet1の行数分だけ繰り返す方法）
（２）ACCESSのテーブルにデータを移し（VBAでも簡単）、テーブルの結合が命という、データーベースソフトを使う。しかしその後VBAを使うことになるかな。
（３）ソートそしてＭａｔｃｈｉｎｇ法
Sheet1とSheet2を発注番号コードと受注番号コードでそれぞれソートする（エクセルの手作業操作やVBAで）
そして両シートを対象にマッチングのアルゴリズムで処理する。其の後結果のデータを望みの順にソートする。
ソート以外の処理時間は、両シートの全行を１読する時間で終わる。
件数的にソートに強いソフトが必要だが、エクセルで、１０万件（行）ぐらいなら、処理時間を辛抱できるのではと推定する。
（３）に興味があれば、簡単な例でのコードを上げますが、質問者が初めて聞くやり方であれば書くのは無駄かとおもう。

回答No.3

nan93850673

>マクロが得意でなく下記の処理が可能かご教授いただければと
> お願いします。

VBAで処理できると思いますが、発注データ、受注データの仕様を教えて貰わないと断言はできません。

回答No.2

ushi2015

こんにちは
シートＡの発注番号コードとシートＢの受注番号コードは必ず一致するのですか？
数量、単価、金額が不一致の場合、シートＡとシートＢのどちらのデータを
シートＣにコピーするのですか？

補足

回答ありがとうございます。
コードは必ず一致します。
シートＡのデータをシートＣに抽出したいと思っております。
よろしくお願いします。

回答No.1

aokii

マクロではないのですが、VLOOKUP関数を使ってみて下さい。

お礼

VLOOKUP関数で現在処理しておりまして、回答ありがとうございます。