2つのシートを重複検索したあと別シートへ転記

Sheet1のL列とSheet2のK列で
重複していないものをSheet3のA列へ転記。
また、重複しているものは一つだけSheet3へ転記。

1行目は見出しタイトル。
エクセル2013 マクロをご教示ください。

No.2 ベストアンサー 回答者： WindFaller 回答日時： 2015/03/08 09:52

こんにちは。

これ自体は、たぶん、記録マクロで十二分に対応できるのではないかと思います。
ただ、掲示板でVBAの技術を錆びつかせないようにしたい人は、もう少し考えたものを作りたいわけだと思います。最初のマクロは、今は古典的にはなりましたが、10年ぐらい前は、みんな、こんなものを書いていたのです。2番目は、今風なのかな？

'//
Sub CombineTwoColumns()
　Dim r1 As Range
　Dim r2 As Range
　Dim ar1 As Variant
　Dim ar2 As Variant
　Dim ar As Variant
　Dim Stocks As Variant
　Dim i As Long, j As Long, k As Long, t As Long
　Dim N As Long
　'-------配列作成---------
　With Worksheets("Sheet1")
　　Set r1 = .Range("L2", .Cells(Rows.Count, "L").End(xlUp))　'見出し行を除く2行目
　End With
　ar1 = r1.Value
　ar1 = Application.Transpose(ar1)
　ar = ar1
　With Worksheets("Sheet2")
　　Set r2 = .Range("K2", .Cells(Rows.Count, "K").End(xlUp))
　End With
　ar2 = r2.Value
　ar2 = Application.Transpose(ar2)
　t = UBound(ar1) + UBound(ar2)
　ReDim Preserve ar(0 To t - 1) '本来の配列の0発進に戻す
　j = 1
　For i = UBound(ar1) + 1 To t
　　ar(i - 1) = ar2(j)
　　j = j + 1
　Next i
　'------ユニークサーチアルゴリズム(自作）--------
　ReDim Stocks(0)
　N = UBound(ar)
　Stocks(0) = ar(0)
　k = 0
　For i = 0 To N
　　For j = 0 To k
　　　If ar(i) = Stocks(j) Then
　　　　Exit For
　　　ElseIf j = k Then
　　　　k = k + 1
　　　　ReDim Preserve Stocks(0 To k)
　　　　Stocks(k) = ar(i)
　　　End If
　　Next j
　Next i
　'---------出力------------
　k = UBound(Stocks)
　With Worksheets("Sheet3")
　.Columns(1).ClearContents　'出力先の消去
　.Range("A1").Resize(k + 1).Value _
　= Application.Transpose(Stocks)
　End With
End Sub
'//

'//
'---------記録マクロ形式---------------

Sub CombineTwoColumns2()
　Dim r1 As Range
　Dim r2 As Range
　
　With Worksheets("Sheet1")
　　Set r1 = .Range("L2", .Cells(Rows.Count, "L").End(xlUp))
　End With
　
　With Worksheets("Sheet2")
　　Set r2 = .Range("K2", .Cells(Rows.Count, "K").End(xlUp))
　End With
　
　With Worksheets("Sheet3")
　　.Columns(1).ClearContents
　　r1.Copy .Cells(1, 27)
　　r2.Copy .Cells(r1.Rows.Count + 1, 27) '作業列(AAを使う）
　　.Range(.Cells(1, 27), .Cells(r1.Rows.Count + r2.Rows.Count, 27)) _
　　.RemoveDuplicates Columns:=1, Header:=xlNo
　　.Range(.Cells(1, 27), .Cells(Rows.Count, 27).End(xlUp)).Copy .Range("A1")
　　.Range(.Cells(1, 27), .Cells(Rows.Count, 27).End(xlUp)).ClearContents
　End With
End Sub
'//

この回答へのお礼

いつもお世話になっています。
古典や今風なんてあるんですね。
どちらも私にとっては『素晴らしい世界』です。(脱帽)
言わずもがな、当然だと思いますが
教えて頂いた両方のマクロの動作を実行、確認、目から鱗な速さでした。

お礼日時：2015/03/08 15:52

No.1 回答者： hallo-2007 回答日時： 2015/03/07 18:24

この手の質問で確認しておきたいことですが

１、Sheet1にあってSheet２にない物（或いはその逆）
２、Sheet1とSheet2のデータをつなげて、2個以上のデータを全て削除
３、Sheet1とSheet2のデータをつなげて、重複を削除
＞重複していないものをSheet3のA列へ転記。
たぶん、2が希望と思いますが
＞重複しているものは一つだけSheet3へ転記。
たぶん、3が希望と思いますが

とりあえず、手作業で
１、新しいシートに　Sheet1のL列を貼り付け
２、その下に、Sheet2のK列を貼り付け

２の場合は
３、B列に　Countif関数を入れて、オートフィルターで一個のデータのみ抽出
３の場合は
３、フィルターオプションの機能を使って、重複データを省いて抽出

４、抽出されたA列をコピーして、Sheet3のA列に貼り付ける。

これで、希望の結果が得られれば、マクロの記録を実施
出来たコードを改良して使いやすい様に仕上げる。

この様な感じで進めて見ては如何でしょうか。

この回答へのお礼

もう少し自力で頑張ってみます。
アドバイスありがとうございました。

お礼日時：2015/03/08 11:02