この記事は、複数の列を比べて重複行を探す、というものです。
「単独の列で重複している行を探す」というサンプルは、
VBAのお勉強 VBAでExcelの重複した行を探して表示
をご覧下さい。
「重複している行を１行だけ残して削除する」というサンプルは、
VBAのお勉強 Excelで１行残して重複行を削除
をご覧下さい。
http://q.hatena.ne.jp/1205154937
「列単位でコンペアさせ、コンペア結果、重複データがある場合」という条件がはっきりしないので、
勝手に「Sheet1のA列のある行のデータがSheet2のA列のどこかにあった場合、重複データとする」としてみました。
イメージとしては、
- Sheet1のA列の1行目の値を取り、その値がSheet2のA列にあるかどうかを調べる。
- あったらその値をSheet3に書き出す、なければそのまま。
- これをSheet1の最後の行まで繰り返す。
という感じでしょうか。
例えばこんな感じのワークシートがあったとします。
まずSheet1のA列の1行目の値「a」に注目します。
この値がSheet2のA列の1～7行目にあれば、Sheet3に書き出します。
この場合、「a」はありませんので何もしません。
次、Sheet1の2行目の「b」。これもないので何もしません。
次、Sheet1の3行目の「c」。これはSheet2のA列の1行目にありますので、 Sheet3に書き出します。
書き出す位置は、これが見つかった値の1個めですからA1にします。
次、Sheet1の4行目の「1」。これもないので何もしません。
次、Sheet1の5行目の「2」。これもないので何もしません。
次、Sheet1の6行目の「3」。これはSheet2のA列の4行目にありますので、 Sheet3に書き出します。
書き出す位置は、これが見つかった値の2個めですからA2にします。
これでSheet1の全部の行を見ました。
これでおっけい(^^)
ではこれをプログラムにしてみます。
Excelから「ツール」→「マクロ」→「Visual Basic Editor」でプロジェクトの中の「Sheet1」をダブルクリック、するとコードを記述するウィンドウが表示されます。
まず、Sheet1のA列を一行ずつ見ていく必要があるので、とりあえず、イミディエイトウィンドウに Sheet1のA列を1行ずつ表示するプログラムを作ってみます。
この記事でやったことと全く同じですね(^^;)
Sub test()
Dim lastgyou As Integer
Dim i As Integer
ActiveSheet.Range("A1").End(xlDown).Select
lastgyou = ActiveCell.Row
For i = 1 To lastgyou
Debug.Print (ActiveSheet.Cells(i, 1).Value)
Next
End Sub
で、実行してみます。
ん、いいんでないかい(^^)
次、こうやって取り出した値を1つずつ、Sheet2にあるかどうかを探す事になりますので、 Sheet2も同じように、A列の何行目までデータが入っているかを調べてみます。
。。。はて。上のプログラムだと、ActiveSheetってなってますので、今現在選択しているシートの事しかわからないですね。
というか、これじゃ、このプログラムを実行したときに選択されているシートの値を表示しちゃうかな？
試しに、Sheet2を選択した状態でこのプログラムを動かしてみると、
(^^;)Sheet2の値が表示されちゃいました。
これじゃ駄目ですね。 どうしたもんか。。。
どのシートが選択されている状態でもSheet1の値を見るようにしないとまずいですね。
プログラムでシートを選択する方法を調べてみます。
Yahoo!で「vba excel シートの選択」で検索すると、こちらのページが見つかりました。
Sheets(“Sheet1″).Select で良いみたいですね。 これをプログラムの先頭に入れてみます。
Sub test()
Dim lastgyou As Integer
Dim i As Integer
Sheets("Sheet1").Select
ActiveSheet.Range("A1").End(xlDown).Select
lastgyou = ActiveCell.Row
For i = 1 To lastgyou
Debug.Print (ActiveSheet.Cells(i, 1).Value)
Next
End Sub
Sheet2を選択した状態で、
プログラムを実行してみます。
ん、Sheet1に切り替わってますね。いいかんじ(^^)
Sheet2について調べたければ Sheets(“Sheet2″).select に切り替えればいいですね。
それでは、Sheet1とSheet2、それぞれ何行目までデータが入っているかを調べてみます。
Sub test()
Dim sheet1lastgyou As Integer
Dim sheet2lastgyou As Integer
Sheets("Sheet1").Select
ActiveSheet.Range("A1").End(xlDown).Select
sheet1lastgyou = ActiveCell.Row
Sheets("Sheet2").Select
ActiveSheet.Range("A1").End(xlDown).Select
sheet2lastgyou = ActiveCell.Row
Debug.Print ("sheet1は" + Str(sheet1lastgyou) + "行目まで")
Debug.Print ("sheet2は" + Str(sheet2lastgyou) + "行目まで")
End Sub
Sheet1の最終行の行番号がsheet1lastgyouに入り、Sheet2がsheet2lastgyouです。
ん、よいようです(^^)
それではとりあえず、Sheet1のデータがSheet2にあるかどうかを調べるプログラムを作ってみます。
Sub test()
Dim i As Integer
Dim j As Integer
Dim check As String
Dim sheet1lastgyou As Integer
Dim sheet2lastgyou As Integer
'Sheet1の最終行を求める
Sheets("Sheet1").Select
ActiveSheet.Range("A1").End(xlDown).Select
sheet1lastgyou = ActiveCell.Row
'Sheet2の最終行を求める
Sheets("Sheet2").Select
ActiveSheet.Range("A1").End(xlDown).Select
sheet2lastgyou = ActiveCell.Row
'Sheet1を1行目から最終行まで
For i = 1 To sheet1lastgyou
'Sheet1を選択します
Sheets("Sheet1").Select
'Sheet1のi行目の値を取り出します
check = ActiveSheet.Cells(i, 1).Value
'Sheet2を選択します
Sheets("Sheet2").Select
'Sheet2を1行目から最終行まで
For j = 1 To sheet2lastgyou
'Sheet2のj行目の値とcheckの値が同じだったら
If ActiveSheet.Cells(j, 1).Value = check Then
'とりあえずイミディエイトウィンドウに表示します
Debug.Print (check)
End If
Next
Next
End Sub
プログラムにコメントを入れてみました。やってることは、さっき言葉で書いたことそのままです。
動かしてみます。
ん、重複している値（「c」と「3」）が表示されました(^^)
あとは、この見つけた値をSheet3に書き出していけばいいですね。
1つ目を見つけたら、Sheet3のA1にその値を入れる、
2つ目を見つけたら、Sheet3のA2にその値を入れる、
以下繰り返しって感じで。
今何個目なのかを入れておく変数を作り、見つけたら、セルに値を入れ、変数を1つ増やす、これで行きます。
Sub test()
Dim i As Integer
Dim j As Integer
Dim check As String
Dim sheet1lastgyou As Integer
Dim sheet2lastgyou As Integer
Dim sheet3gyou As Integer
'Sheet1の最終行を求める
Sheets("Sheet1").Select
ActiveSheet.Range("A1").End(xlDown).Select
sheet1lastgyou = ActiveCell.Row
'Sheet2の最終行を求める
Sheets("Sheet2").Select
ActiveSheet.Range("A1").End(xlDown).Select
sheet2lastgyou = ActiveCell.Row
'Sheet3の行数を0にしておく
sheet3gyou = 0
'Sheet1を1行目から最終行まで
For i = 1 To sheet1lastgyou
'Sheet1を選択します
Sheets("Sheet1").Select
'Sheet1のi行目の値を取り出します
check = ActiveSheet.Cells(i, 1).Value
'Sheet2を1行目から最終行まで
For j = 1 To sheet2lastgyou
'Sheet2を選択します
Sheets("Sheet2").Select
'Sheet2のj行目の値とcheckの値が同じだったら
If ActiveSheet.Cells(j, 1).Value = check Then
'Sheet3に代入するセルの行数を1つ増やします。
sheet3gyou = sheet3gyou + 1
'Sheet3を選択します
Sheets("Sheet3").Select
'セルに見つけた値を代入します
ActiveSheet.Cells(sheet3gyou, 1).Value = check
End If
Next
Next
End Sub
sheet3gyouという変数を設け、最初は0、見つけたら1つ増やして、 Sheet3に切り替え、見つけた値をセルに代入する、という感じです。
プログラムを動かしてみると。。。
ん、いいんでないかい？(^^)
これで完成、、、と思ったんですけど。
今入ってるデータだったら問題ないんですけど、 Sheet1内、Sheet2内で重複しているデータがあった場合、例えばこんな感じ。
この状態で実行すると、
こんな感じ。「a」はいいとして、「b」「c」が2つ出てます。
「b」はSheet1に2つありますから、それぞれがSheet2の1つと一致します。
なので、2つ出ます。「c」はSheet1の1つがSheet2の2つと一致しますので、やはりこれも2つ出ます。
重複しているものは出ているので、これでいいっちゃいいんですけど、ここは、
こう出たほうがスマートですかね？(^^;)
さて、どうやろうかな。
Sheet2の中で重複している場合（この場合「c」）は、Sheet2を上から見ていくとき、 1つ目が見つかった段階で、もうその値を探すのを止めてしまえばよさそうです。
見つかった場合、forのループを抜け出してしまう感じですね。
Sub test()
Dim i As Integer
Dim j As Integer
Dim check As String
Dim sheet1lastgyou As Integer
Dim sheet2lastgyou As Integer
Dim sheet3gyou As Integer
'Sheet1の最終行を求める
Sheets("Sheet1").Select
ActiveSheet.Range("A1").End(xlDown).Select
sheet1lastgyou = ActiveCell.Row
'Sheet2の最終行を求める
Sheets("Sheet2").Select
ActiveSheet.Range("A1").End(xlDown).Select
sheet2lastgyou = ActiveCell.Row
'Sheet3の行数を0にしておく
sheet3gyou = 0
'Sheet1を1行目から最終行まで
For i = 1 To sheet1lastgyou
'Sheet1を選択します
Sheets("Sheet1").Select
'Sheet1のi行目の値を取り出します
check = ActiveSheet.Cells(i, 1).Value
'Sheet2を1行目から最終行まで
For j = 1 To sheet2lastgyou
'Sheet2を選択します
Sheets("Sheet2").Select
'Sheet2のj行目の値とcheckの値が同じだったら
If ActiveSheet.Cells(j, 1).Value = check Then
'Sheet3に代入するセルの行数を1つ増やします。
sheet3gyou = sheet3gyou + 1
'Sheet3を選択します
Sheets("Sheet3").Select
'セルに見つけた値を代入します
ActiveSheet.Cells(sheet3gyou, 1).Value = check
'1つ目が見つかったので、ループから抜けます
Exit For
End If
Next
Next
End Sub
見つかった後、セルに代入した後でExit forでループを抜け出します。実行してみると、
ん、「c」は1つだけになりました(^^)。
後は、Sheet1内で重複していた場合ですね。
Sheet1を1行ずつ見ていって、これからチェックしようとする値（checkという変数に代入しています）が、それまで見てきた行の中にあるかどうかをチェックし、もしもあった場合、その行を飛ばす、というのでどうでしょうか。
これなら、Sheet1の3行目の「b」を見ているときは、すでに2行目に「b」がありますから、飛ばすことになります。
というわけで、プログラムにしてみます。
Sub test()
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim atta As Integer
Dim check As String
Dim sheet1lastgyou As Integer
Dim sheet2lastgyou As Integer
Dim sheet3gyou As Integer
'Sheet1の最終行を求める
Sheets("Sheet1").Select
ActiveSheet.Range("A1").End(xlDown).Select
sheet1lastgyou = ActiveCell.Row
'Sheet2の最終行を求める
Sheets("Sheet2").Select
ActiveSheet.Range("A1").End(xlDown).Select
sheet2lastgyou = ActiveCell.Row
'Sheet3の行数を0にしておく
sheet3gyou = 0
'Sheet1を1行目から最終行まで
For i = 1 To sheet1lastgyou
'Sheet1を選択します
Sheets("Sheet1").Select
'Sheet1のi行目の値を取り出します
check = ActiveSheet.Cells(i, 1).Value
'attaという変数を0にします。
atta = 0
'もし、Sheet1の2行目以降を見ている場合
If i >= 2 Then
'今見ている行の前の行までに今回の値があるかどうかを探します
For k = 1 To i - 1
If ActiveSheet.Cells(k, 1).Value = check Then
atta = 1
Exit For
End If
Next
End If
'もし、atta=0ならば、Sheet2を探します。
If atta = 0 Then
'Sheet2を1行目から最終行まで
For j = 1 To sheet2lastgyou
'Sheet2を選択します
Sheets("Sheet2").Select
'Sheet2のj行目の値とcheckの値が同じだったら
If ActiveSheet.Cells(j, 1).Value = check Then
'Sheet3に代入するセルの行数を1つ増やします。
sheet3gyou = sheet3gyou + 1
'Sheet3を選択します
Sheets("Sheet3").Select
'セルに見つけた値を代入します
ActiveSheet.Cells(sheet3gyou, 1).Value = check
'1つ目が見つかったので、ループから抜けます
Exit For
End If
Next
End If
Next
End Sub
新たに、attaとkという変数を作りました。
もし、Sheet1の2行目以降を探す場合、それ以前の行の値を For k=1 to i-1 ということで、1行目から、今探している行（i）の1つ前までループし、その行のセルの値が、checkの値と同じかどうかを調べ、同じだったら、attaという変数に1を入れます。
もし見つからなかったら、attaの変数は0のままですので、 attaが0だったら、今度はSheet2を調べる、という事になります。
プログラムを実行すると、、、
ん、いいんでないかい(^^)
いちおう、これで完成、でいいかな・・・？
こちらにアップしておきます→vbastudy_0006.xls
