excellVBAで、シートからデータを移す方法

質問

複数のシートから、データが被らないようにコピーする方法を探しています。

・コマンドボタンを押すと、シートA、シートB、シートCの全データをシートDにコピーする
・ただしデータが被っている行は、1度しかコピーしない

例として、以下のようなシートがあるとします。

・シートA
品目　価格　日付
りんご　100円　4/13
バナナ　80円　4/10
スイカ　200円　5/10
メロン　300円　5/21
なし　120円　5/23

・シートB
品目　価格　日付
メロン　300円　5/21
バナナ　80円　4/10
りんご　100円　4/22

・シートC
品目　価格　日付
スイカ　200円　5/10
なし　150円　4/23

コマンドボタンを押すと上の3シートから、シートDに以下のデータが転記される
品目　価格　日付
りんご　100円　4/13
バナナ　80円　4/10
スイカ　200円　5/10
なし　120円　5/23
メロン　300円　5/21
りんご　100円　4/22
なし　150円　4/23

このような動作をしたいのですが、どのようにするのが効率良いでしょうか？

今のところ私は、
１、シートAのデータの入っている行を全てシートDにコピーする
２、シートBの1行目から順に、コピー済みの全行と比較して被っているかチェック
３、被っていない行はシートDにコピー。
４、シートCの1行目から順に、コピー済みの全行と比較して被っているかチェック
５、被っていない行はシートDにコピー。

という動作しか思いつかないのですが、どうも効率が悪い気がしてなりません。
何か良い方法はないでしょうか。
ちなみにデータの入っている列は全シート5列で固定（正式名、品名、価格、サイズ、日付の5列）
行はシートによって異なり、50行～20000行くらいです。

説明が分かりづらいかも知れませんが、よろしくお願い致します。

回答No.3

mt2008 · ベストアンサー

シートDに全てのシートのデータを結合した表（重複を含む）を作成した後、フィルタで重複を非表示すると効率が良いように思えます。
非表示でも重複データが存在する事がNGなら表示データだけコピーして別なシートに貼り付ければ良いでしょう。

＃以下のコードはサンプルですのでエラー処理を行っていません。

Sub Sample()
　　Dim nLast
　　With Sheets("SheetD")
　　　　'SheetDの項目名
　　　　.Range("A1:C1") = Sheets("SheetA").Range("A1:C1").Value

　　　　'各シートからデータをコピー
　　　　Call fCopyData("SheetA")
　　　　Call fCopyData("SheetB")
　　　　Call fCopyData("SheetC")

　　　　'重複を非表示
　　　　nLast = .Cells(Rows.Count, 1).End(xlUp).Row + 1
　　　　.Range("A1:C" & nLast).AdvancedFilter Action:=xlFilterInPlace, Unique:=True
　　End With
End Sub

Sub fCopyData(aSheetName As String)
　　Dim vData, nLast
　　'指定シートのデータをコピー
　　With Sheets(aSheetName)
　　　　If .Range("A2") = "" Then Exit Sub
　　　　.Range(.Range("A2"), .Range("C2").End(xlDown)).Copy
　　End With
　　'SheetDの最終行に貼り付け
　　With Sheets("SheetD")
　　　　nLast = .Cells(Rows.Count, 1).End(xlUp).Row + 1
　　　　.Cells(nLast, 1).PasteSpecial Paste:=xlPasteValues
　　　　.Cells(nLast, 1).PasteSpecial Paste:=xlPasteFormats
　　End With
End Sub

回答No.5

merlionXX

一例です。
作業シートにすべて貼り付ける。
エクセルのフィルタオプションを利用して重複を非表示に。
可視セルのみをシートDに貼り付け。
作業シートを削除。
というコードです。

Sub test01()
　　Dim ws(2) As Worksheet '変数宣言
　　Set ws(0) = Worksheets.Add　'作業シート追加
　　Set ws(1) = Sheets("D")
　　For Each ws(2) In Sheets(Array("A", "B", "C"))　'各シートコピー
　　　　ws(2).Range("A1", ws(2).Cells(Rows.Count, "C").End(xlUp)).Copy ws(0).Cells(Rows.Count, 1).End(xlUp).Offset(1)
　　Next ws(1)
　　With ws(0) '作業シートに貼り付けし重複削除してシートDに貼り付け
　　　　.Range("A2").CurrentRegion.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
　　　　.Range("A2").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy ws(1).Range("A1")
　　　　Application.DisplayAlerts = False
　　　　.Delete '作業シート削除
　　　　Application.DisplayAlerts = True
　　End With
End Sub

回答No.4

Siegrune

EXCEL2007ならデータの中に、重複の削除機能があるから、
シートAからシートCまで全部シートDへコピーして、
重複の削除１回で終わりです。
（マクロの記録しておけば、VBAの記述も分かると思います。）

ただし、EXCEL2003にはこの機能がありません。

回答No.2

mu2011

一案です。
（１）行データを連結（区切り文字あり）、それをキーに連想配列を作成（重複分を吸収）
（２）連想配列からキーを取り出し、Splitで再配列してＤシートにコピー

回答No.1

noname#159900

シートAで配列を作る、「りんご=A1」「バナナ＝A2」・・・
シートBをその配列の中を巡回する、あれば捨てて、無ければ新規にA6とかつくる。
最後にシートDに入れて、終わり。