エクセル マクロ 複数のシート間で、セルの組み合わせがマッチしない行を、別シートへ移動する方法教えてください！！

質問

Sheet1には今月の、Sheet2には先月の顧客NO.、会社名、商品名、金額データがあります。Sheet1にはエリア情報がありますが、Sheet2にはありません。
これらエリア情報を除く4つのセルの内容、全てマッチしている行はそのままで、１つでも違う組み合わせのあるものがあれば、Sheet3ヘ移動したいのですが。。
つまり今月新しく上がってきたもののみを行ごと、別のシートに移動できればと思います。
下記のイメージです。

<Sheet1>　今月分
No.　会社　　　　商品　　　　金額　　　エリア
123　ABC商事　　ペン　　　　￥500　　　新宿区　　　
456　DEFコープ　ノート　　　￥200　　　渋谷区
789　GHI　　　　 DVD　　　 ￥30000　 中野区
113　UFP　　　　 CD ￥25000　　港区

<Sheet2>　先月分
No.　会社　　　　商品　　　　金額
155　XXX　　　　クリップ　　￥4000
456　DEFコープ　ノート　　　￥200
113　UFP　　　　 CD　　 　　￥25000

<Sheet3>　今月NEW分
123　ABC商事　　ペン　　　　￥500　　　新宿区
789　GHI　　　　 DVD　　　 ￥30000　 中野区
どなたか分かる方いらっしゃいますか？
教えてください！！

回答No.4

kobouzu_su

簡単なコードにも拘わらずなかなか回答が付かないようなので、一案。

Sheet1（今月分）１行目：見出し、　２行目～：データ
Sheet2（前月分）１行目：見出し、　２行目～：データ
Sheet3（抽出分）１行目：見出し、　２行目～：抽出データ

'------------------------------------------------------
Sub Test()
　　Dim R As Long
　　Dim LastRow As Long
　　Dim myCell As Range

　　With Sheets("Sheet3")
　　　　.Select
　　　　.Cells.Clear
　　End With

　　With Sheets("Sheet2")
　　　　For R = 2 To .Range("A65536").End(xlUp).Row
　　　　　　.Cells(R, "G") = .Cells(R, "A") & .Cells(R, "B") & .Cells(R, "C") & .Cells(R, "D")
　　　　Next R
　　End With

　　With Sheets("Sheet1")
　　　　For R = 2 To .Range("A65536").End(xlUp).Row
　　　　　　.Cells(R, "G") = .Cells(R, "A") & .Cells(R, "B") & .Cells(R, "C") & .Cells(R, "D")
　　　　Next R

　　　　For R = 2 To .Range("A65536").End(xlUp).Row
　　　　　　Set myCell = Sheets("Sheet2").Columns("G").Find(.Cells(R, "G"), , xlValues, xlWhole)
　　　　　　If myCell Is Nothing Then
　　　　　　　　LastRow = Sheets("Sheet3").Range("A65536").End(xlUp).Row + 1
　　　　　　　　.Rows(R).Copy Sheets("Sheet3").Cells(LastRow, "A")
　　　　　　End If
　　　　Next R

　　　　.Rows(1).Copy Sheets("Sheet3").Cells(1, "A")
　　End With

　　Sheets("Sheet3").Columns("G").Delete xlShiftToLeft
　　Sheets("Sheet2").Columns("G").Delete xlShiftToLeft
　　Sheets("Sheet1").Columns("G").Delete xlShiftToLeft
End Sub
'--------------------------------------------------------------------------------

コードを見てもらえれば分かると思いますが、
Sheet1,2　の”No.と会社と商品と金額”を結合したものを使用してない列（今回は、Ｇ列）にセットしそれを検索に使ってます。
また、Sheet3の見出しは、Sheet1の見出しをコピーしてます。

それから、も少し短いコードで、かつ作業列を使わない方法もありますが、それだとデータ件数が多いと遅くなるので速い方法にしました。
質問では「移動」となってますが、一応、「コピー」にしてあります。

以上です。

お礼

kobouzu_suさん
ありがとうございした。

.Rows(R).Copy Sheets("Sheet3").Cells(LastRow, "A")を
.Rows(R).Copy Sheets("Sheet3").Cells(R, "A")　に変更して成功しました！

回答No.3

NOBNNN

失礼しました。

複数テーブルの単純なクエリならＳＥＬＥＣＴできましたが
結合や　Exsits は EXCEL ではできないようです。

Access にデータをインポートしてでの上記クエリを使用しての
操作はできます。
抽出後、Excel にエクスポートすれば簡単です。

もしくは上記参考ＨＰの方法で行うには
Data1 側のみ　Select でレコードセット　作成し、
data2　はＥＸＣＥＬで開きワークシートの操作で1件ずつ
データを検索してみれば可能かと思います。

やはりAccess上で行った操作が一番簡単です。

回答No.2

NOBNNN

NO1.です。

クエリに誤りがありました。
以下のクエリと置き換えてください。
___________________________________________________
SELECT *
FROM DATA1
where NOT EXISTS ( Select * from DATA2
where (DATA1.[No] = DATA2.[No])
AND (DATA1.会社 = DATA2.会社)
AND (DATA1.商品 = DATA2.商品)
AND (DATA1.金額 = DATA2.金額) )
_______________________________________________________________

以上

お礼

ありがとうございます。
頂いたサイトとNOBNNNさんからのクエリを元に修正したのですが、
SELECT のところで、コンパイルエラーが出てしまいます。

objRecordset.Open
SELECT *　FROM DATA1
where NOT EXISTS ( Select * from DATA2
where (DATA1.[No] = DATA2.[No])
AND (DATA1.会社 = DATA2.会社)
AND (DATA1.商品 = DATA2.商品)
AND (DATA1.金額 = DATA2.金額) )
objConnection, adOpenStatic, adLockOptimistic, adCmdText

どこがいけないのでしょうか？

回答No.1

NOBNNN

ACCESS 2003　なら簡単にできます。
クエリで
二つのテーブルを比較すればよいわです。
______________________________________________________________
◆ Sheet1もしくはSheet2　にしか存在しないデータを抽出

Select No,会社,商品,金額 FROM Sheet1_TBL
INNER Join Sheet2_TBL
On key NOT ( Sheet1_TBL.No = Sheet2_TBL.No and
Sheet1_TBL.会社 = Sheet2_TBL.会社 and
Sheet1_TBL.商品 = Sheet2_TBL.商品 and
Sheet1_TBL.金額 = Sheet2_TBL.金額)
___________________________________________________________＿
このクエリを　EXCEL でAccess と同じように　Excelシートを
テーブルに見立てて ADO　で抽出できます。

参考ＨＰ
　→　ADO を使用して Excel ワークシートにクエリを実行する
http://www.microsoft.com/japan/technet/scriptcenter/resources/officetips/jun05/tips0607.mspx

を参考にプログラムを作成してみてください