VBAで重複していない行を削除したいです。

質問

初めてgoo質問を使います。

sheet1とsheet2の１列目と２列目で重複していない行を
sheet2から削除したいです。

例えば、
Aの列に番号？、Ｂの列に数字
sheet1
A B CDEF
1 番号A 1
2 番号A 2　
3 番号A 3
4 番号C 1
5 番号C 2
6 番号F 6
7 番号F 7
8 番号F 8
9 番号F 9
10 番号F 10

sheet2
A B CDEF
1 番号A 1
2 番号A 2　
3 番号A 3
4 番号B 1
5 番号B 2
6 番号B 3
7 番号C 1
8 番号C 2
9 番号D 8
10 番号D 10

があったとして、上記を下記のようにしたいです。
sheet2
A B CDEF
1 番号A 1
2 番号A 2　
3 番号A 3
4 番号C 1
5 番号C 2
6 番号F 6
7 番号F 7
8 番号F 8
9 番号F 9
10 番号F 10

CDEFの列にはsheet1とsheet2で違うデータが入っています。
sheet2から重複していない行を削除したいです。
宜しくお願いします。

回答No.2

kmetu · ベストアンサー

No1の方もいわれてますが説明と結果のデータが違いますけど、一応結果のデータを信用するとして、以下のコードでいかがでしょう。気分的には、削除の後で追加するのでデータのあり方によっては、なにかしらゾンビのように復活するデータが出てくるかもしれません。

削除だけしたいのでしたら、下にある追加と書かれている部分から下のEnd Withまでを削除してください。

Sub Sample()
Dim i As Long
Dim c As Range
Dim delFLG As Boolean
Dim addFLG As Boolean

'削除　Sheet2にあってSheet1にないものを削除
With Sheets("Sheet2")
For i = .Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
delFLG = True
For Each c In Sheets("Sheet1").Range("A1:A" & Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row)
If .Range("A" & i).Value & .Range("A" & i).Offset(0, 1).Value = c.Value & c.Offset(0, 1).Value Then
delFLG = False
End If
Next
If delFLG = True Then
.Range("A" & i).Delete Shift:=xlUp
End If
Next i
End With

'追加　Sheet1にあってSheet2に無いものを追加
With Sheets("Sheet1")
For i = 1 To .Range("A" & Rows.Count).End(xlUp).Row
addFLG = True
For Each c In Sheets("Sheet2").Range("A1:A" & Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row)
If .Range("A" & i).Value & .Range("A" & i).Offset(0, 1).Value = c.Value & c.Offset(0, 1).Value Then
addFLG = False
End If
Next
If addFLG = True Then
.Range(.Cells(i, "A"), .Cells(i, "A").Offset(0, 1)).Copy
Sheets("Sheet2").Range("A" & Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row + 1).PasteSpecial
Application.CutCopyMode = False
End If
Next i
End With
End Sub

回答No.8

anmochi

> マクロを実行してみたのですが、
> 何も起こりませんでした。
> エラーが出てデバッグするところもありませんでした。
まじでか。ん～。もちろんこれは対象のSheet1とSheet2があるExcelブックで標準モジュールを追加しなてそちらにマクロを書き込まないと駄目だぜ。多分その辺は大丈夫だと思うんだけど。

本当はこんな事言いたくないんだが、ここは「こういう事をするマクロを作ってください」というサイトではなく「こういう事をしたいのだがどういうマクロをかけば良いのか分からないからアドバイスください」というサイトだ。つまり、最終的にマクロを作るのはあなたであって、あなたが私やもう一人の回答者さんのマクロを参考にしつつ自分でやらなきゃ身につかないぜ。
まずは得られた回答から各マクロで何をやっているのか、どうしてここにIｆが来るのか、何と何の値を比較しているのか、など分かる範囲からでいいから読んで解釈してみる、マクロと対象データが目の前にあるのだからステップ実行してなぜ自分の意図通りの結果にならないのか確かめる、など、マクロの修正を要求する前にできることはいくらでもあるんじゃないか。

本気で「こういう事をするマクロを作ってください」と思っていたならばここじゃなくてクラウドワークスでも行ってください。

お礼

頼りすぎるとよくありませんね。
いろいろありがとうございました。

補足

返信ありがとうございます。
まだマクロが動きっぱなしで
できているのかがまだはっきりとわからなかったので
返信が遅れてしまいました。すいません。
いろいろアドバイスありがとうございます。

回答No.7

kmetu

No6の追加です。たびたび追加ですみません。

画面の描画を解除するとVBAの実行が終わったのが分からないかもしれませんので

End Subの前に追加した
Application.ScreenUpdating = True
の後に
MsgBox " 終了しました。　　　　", vbInformation
を入れておいてください。

お礼

ありがとうございます。
なんとかなりました。
丁寧に教えてくださって感謝しています。

回答No.6

kmetu

No5の追加です。

時間がかかる問題で、画面の描画をVBA実行中だけ一時停止したほうがいいと思いますので

コードの
'削除　Sheet2にあってSheet1にないものを削除
と書かれている上に

Application.ScreenUpdating = False

を追加して

最後の
End Sub
の前に

Application.ScreenUpdating = True

を追加しておいてください。

回答No.5

kmetu

> データが多すぎて時間がかかってしまったのと、

確かにデータが多いと時間がかかると思います。
それで、よく見たら検索結果が出ているにもかかわらず検索を続けている部分がありましたので、以下のように修正してみてください。

削除ブロックの部分

delFLG = False
のところを
delFLG = False
Exit For
に

追加ブロックの部分

addFLG = False
のところを
addFLG = False
Exit For
に

あとA列とB列で変更が無いのでしたら
Range("A" & i).Offset(0, 1).Value
となっているところを
Range("B" & i).Value
にしてみてください。

Offsetを使ったのは、もしかして、本来のデータがA列とB列ではない場合、Aの指定だけを本来の列に修正すれば楽だろうと思ってやったことなので、無駄な関数を無くすことにより時間短縮につながるかもしれません。

> できたところとできなかったところがあるみたいで

このあたりは、実際のデータを確認しないとなんともこちらではわからないところですが、削除の部分と追加の部分を別に実行してみて、どちらで、おかしくなるのかを確認してみてください。

また、削除できなかったのでしたら理屈的にはSheet2にあってSheet1にもあったということになりますので、ご面倒ですがSheet1の利用していないセルに=A1&B1としてデータ分下にコピーしていただいて、その列を選択し、検索を利用し、削除できなかったSheet2のA列とB列のデータを、そのまま検索する文字列のボックスにA列B列の順にコピーしてもらって検索を掛けてみてください。

追加の場合は、削除の部分を実行後、シートを逆に考えて検索を実行してみてください。

どちらの場合も、検索でヒットしなければ何かしらコードにおかしいところがある事になりますが、現在考える限りでは、私のつたない頭ではおかしそうなところは見つかりませんでした。

回答No.4

anmochi

> sheet1とsheet2のA列とB列がそれぞれセットで一致している行は
> 残しておきたいんです。
> sheet1の方が行は少ないです。
ふむふむ。

> ・sheet1とsheet2のAB列を見比べる。
> ・A列とB列はどちらも昇順に並んでいる。
> ・sheet1に無くてsheet2にものをsheet2から削除。
> まではその通りです。
おーけー。

> ・sheet1に有ってsheet2に無いA列とB列はありません。
おおうこういう条件があるなら楽勝だわ。
以下、Sheet1とSheet2いずれかのA列が空っぽになったら終わるという終了条件で
要求を満たすプロシージャーを書いてみた。

１．Excelを開いてShift＋F11でVBA画面を開く

２．標準モジュールを作る。例えばModule1
～～～～Module1の中身～～～～
Option Explicit

Public Sub DeleteFromSheet2ExcludeMatchingSheet1()
Dim sht1 As Excel.Worksheet
Dim sht2 As Excel.Worksheet
Set sht1 = ThisWorkbook.Worksheets("Sheet1")
Set sht2 = ThisWorkbook.Worksheets("Sheet2")

Dim l1 As Long
Dim l2 As Long
l1 = 1
l2 = 1

Do While sht1.Range("A" & CStr(l1)).Value <> "" And sht2.Range("A" & CStr(l2)).Value <> ""
If sht1.Range("A" & CStr(l1)).Value <> sht2.Range("A" & CStr(l2)).Value _
Or sht1.Range("B" & CStr(l1)).Value <> sht2.Range("B" & CStr(l2)).Value Then
Call sht2.Rows(l2).Delete
Else
l2 = l2 + 1
l1 = l1 + 1
End If
Loop
Do While sht2.Range("A" & CStr(l2)).Value <> ""
Call sht2.Rows(l2).Delete
Loop
End Sub
～～～～～～～～

これで、Excelを開いてAlt＋F8を押すと実行可能マクロ一覧画面が出てきて
DeleteFromSheet2ExcludeMatchingSheet1
が選択肢にあるのでそいつを選ぶとやってくれるぜ。

もちろん、先にバックアップをとってから試してみてくれ。

補足

返信ありがとうございます。
マクロを実行してみたのですが、
何も起こりませんでした。
エラーが出てデバッグするところもありませんでした。

以下、Sheet1とSheet2いずれかのA列が空っぽになったら終わるという終了条件で
要求を満たすプロシージャーを書いてみた。
が良く分からなかったのですが、

sheet1とsheet2の列Ａと列Ｂが一致している行は残して、
列Ａと列Ｂが一致していない行はsheet2から消したいです。
宜しくお願いします。

回答No.3

kmetu

No2です。訂正と補足です

削除のブロックで
.Range("A" & i).Delete Shift:=xlUp
のところを
.Rows(i).Delete Shift:=xlUp
に変更してください

また、追加のブロックで現在はA列とB列を追加することにしていますがF列までデータがあるのでしたら

.Range(.Cells(i, "A"), .Cells(i, "A").Offset(0, 1)).Copy
のところを
.Range(.Cells(i, "A"), .Cells(i, "A").Offset(0, 5)).Copy
に変更するか
行のデータを全て追加でよければ
.Rows(i).Copy
に変更してください。

補足

返信ありがとうございます。
マクロを実行してみたのですが、
データが多すぎて時間がかかってしまったのと、
できたところとできなかったところがあるみたいで
返信が遅れてしまいました。

できる所とできない所がなざできるのかわかりません。
どうすればいいでしょうか？
宜しくお願いします。

回答No.1

anmochi

ん～。仕様をまとめると
・sheet1とsheet2のAB列を見比べる。
・A列とB列はどちらも昇順に並んでいる。
・sheet1に無くてsheet2に有るものをsheet2から削除。
・sheet1に有ってsheet2に無いものをsheet1からコピー。　←ここが正しいか要確認
という事でよいだろうか。

単純にsheet2は削除だけじゃないよね。sheet2の結果に最初はなかった「番号Fの10」が10行目に出来上がってるんだから。この場合はCDEF列はsheet1の内容をコピーするという事で良いのかい？
それか結果の方が誤りなのかな？　「sheet2から重複していない行を削除」という言葉を額面通りに受け取ると、結果は以下のようになるはずだ。
sheet2
A B CDEF
1 番号A 1
2 番号A 2　
3 番号A 3
4 番号C 1
5 番号C 2

どちらが正しいのか教えてもらっていいかな。

補足

回答ありがとうございます。
わかりにくくてすいません。

sheet1とsheet2のA列とB列がそれぞれセットで一致している行は
残しておきたいんです。
sheet1の方が行は少ないです。

・sheet1とsheet2のAB列を見比べる。
・A列とB列はどちらも昇順に並んでいる。
・sheet1に無くてsheet2にものをsheet2から削除。
まではその通りです。

・sheet1に有ってsheet2に無いA列とB列はありません。
sheet1とsheet2にはもっとたくさん行が
あったのでこのような形に書いてしまいました。
宜しくお願いします。