エクセルのマクロで重複データーを削除する

Sub Sample()
Dim i As Long
With Range("B:B")
For i = .CurrentRegion.Rows.Count To 1 Step -1
If .Offset(i, 0) = .Offset(i - 1, 0) Then .Offset(i, 0).EntireRow.Delete
Next i
End With
End Sub

上記のマクロを実行するとエラーがでますが、どこを直せばわかりません。
一つのブックのシート全体のB列の重複データーを削除したいのですが、教えて頂けないでしょうか？

No.9 ベストアンサー 回答者： onlyrom 回答日時： 2009/02/19 13:47

またまたまた登場、onlyromです。

　
>一つのブックのシート全体に適応させたい

これは２つの意味に取れますが。。。。

●例えば、各シートのＢ列を県名と仮定する

（１）ブック全体をひとつのシートとみなしてのダブり削除
　　　シート１、２、３のＢ列に”東京”があったら
　　　シート１の”東京”を残し、シート２，３の”東京”を削除する

（２）ブック全体の各シート内でのダブり削除
　　　シート１、２、３のＢ列に”東京”があっても
　　　各シート内ではダブっていないので、削除しない
　　　
たぶん（１）だと思いますが９９％同じコードなので２つともアップ

（１）ブック全体をひとつのシートとみなした場合
'-------------------------------------------------
Sub TestBook()
　Dim R As Long
　Dim LastRow As Long
　Dim Sht As Worksheet
　Dim myDic

　Set myDic = CreateObject("Scripting.Dictionary")

For Each Sht In ActiveWorkbook.Worksheets
　　LastRow = Sht.Cells(Rows.Count, "A").End(xlUp).Row
　　For R = LastRow To 2 Step -1
　　　　If myDic.exists(Sht.Cells(R, "B").Value) Then
　　　　　　Sht.Rows(R).Delete xlShiftUp
　　　　Else
　　　　　　myDic.Add Sht.Cells(R, "B").Value, ""
　　　　End If
　　Next R
Next Sht

End Sub
'-------------------------------------------------------

（２）各シート内でのダブり削除
'-------------------------------------------------------
Sub TestSheet()
　Dim R As Long
　Dim LastRow As Long
　Dim Sht As Worksheet
　Dim myDic

　Set myDic = CreateObject("Scripting.Dictionary")

For Each Sht In ActiveWorkbook.Worksheets
　　LastRow = Sht.Cells(Rows.Count, "A").End(xlUp).Row
　　For R = LastRow To 2 Step -1
　　　　If myDic.exists(Sht.Cells(R, "B").Value) Then
　　　　　　Sht.Rows(R).Delete xlShiftUp
　　　　Else
　　　　　　myDic.Add Sht.Cells(R, "B").Value, ""
　　　　End If
　　Next R

　　myDic.RemoveAll　　'●ここだけが違う

Next Sht

End Sub
'-------------------------------------------------------

２つのコードで違いは、●印のmyDic.RemoveAllがあるかないかだけです。

また、上記のようにDictionaryオブジェクトを使うと、Ｂ列のデータは、ソートされてなくてもＯＫです。

新しいブックに簡単なテストデータを作成し試してください。
以上。
　

この回答への補足

ありがとうございます。
私の説明不足ですいません、回答は２のほうでした。
試しましたら正確に動きました、二つのコードの違いが

>myDic.RemoveAllがあるかないかだけです。

だけとは最初見てもわからなかったのでまだまだ勉強が足りません、
今回非常に勉強になりました、ありがとうございました。

補足日時：2009/02/19 15:36

No.8 回答者： onlyrom 回答日時： 2009/02/18 22:28

またまた登場、回答５、onlyromです。

>下記のサンプルを試すとエラーがでました。

いやはや、申し訳ありませぬ。
With ステートばかりに目がいってました。

＞For i = Range("A1").CurrentRegion.Rows.Count To 1 Step -1

これでは最終行から１行目までになり、iが１になったときエラーが出ますので、
次のように最終行から２行目まで回すようにしなければいけませんね。
●の部分。

For i = Range("A1").CurrentRegion.Rows.Count To ●２● Step -1

'---------------------------------------------------
Sub Sample()
Dim i As Long
For i = Range("A1").CurrentRegion.Rows.Count To 2 Step -1
If Cells(i, "B").Value = Cells(i - 1, "B").Value Then
Cells(i, "B").EntireRow.Delete
End If
Next i
End Sub
'----------------------------------------------------

それから、
＞サンプルに複数のシートを対応させると試しに書いてみました

この意味が分かりません。。。文章もちょと怪しいし。。(^^;;;
　

この回答への補足

ご丁寧にありがとうございました。

＞それから、
＞サンプルに複数のシートを対応させると試しに書いてみました
↓
書いて頂いたサンプルコードは一つのシートだけの対応でしたので、
一つのブックのシート全体に適応させたいというのが最終目標でして
試しに書いてみましたがエラーになりどうしていいものかまいっているしだいです。

補足日時：2009/02/19 08:31

No.7 回答者： don9don9 回答日時： 2009/02/18 18:12

エラーの原因は他の回答にありますので省略します。

http://officetanaka.net/excel/vba/tips/tips14.htm

上記サイトの「Sample02」のコードを参考に

Sub Sample()
Dim i As Long
With Range("B1")
For i = .CurrentRegion.Rows.Count To 1 Step -1
If .Offset(i, 0) = .Offset(i - 1, 0) Then .Offset(i, 0).EntireRow.Delete
Next i
End With
End Sub

とすればよいとは思いますが
この場合、B列がソートされている必要がありますので
少し変更して

Sub Sample()
Dim i, j As Long
With Range("B:B")
For i = 1 To .CurrentRegion.Rows.Count Step 1
With Range("B" & i)
If .Value = "" Then Exit For
For j = .CurrentRegion.Rows.Count To 1 Step -1
If .Offset(j, 0) = .Value Then .Offset(j, 0).EntireRow.Delete
Next j
End With
Next i
End With
End Sub

とすれば、B列のデータが順不同で入っていても重複分を削除できます。
但し当然ですが前者のコードより処理は遅くなりますので注意下さい。
何万行も処理しようとするとフリーズするかもしれません。
（未確認です）

この回答への補足

ありがとうございました。上記のソース確認いたしました。
あとはブックのシート全体に反映させるだけですね・・・・

補足日時：2009/02/18 19:04

No.6 回答者： n-jun 回答日時： 2009/02/18 17:26

＃２です。

＞A列もC列もデーターはありますが、B列に重複があれば、重複しているデーターを一つ残して
＞（A列とC列のデーターは保存）行ごと削除です。
もしかするとＢ列の重複しているデータを１個だけ表示して、あとは空白にすると
言う事ではないのでしょうか？

　　Ａ　Ｂ　Ｃ
1　111 aaa zzz
2　222 aaa yyy
3　333 aaa xxx
とあったら
　　Ａ　Ｂ　Ｃ
1　111 aaa zzz
2　222 　　yyy
3　333 　　xxx
とか？

違っていたらスル～して下さい。

No.5 回答者： onlyrom 回答日時： 2009/02/18 17:16

回答４にもありますが、原因は、With Range("B:B")　です。

例えば、i=50　を考えてみましょう

.Offset(50,0)
　→　Range("B:B").Offset(50,0)
　→　Range("B1:B65536").Offset(50,0)

こうなりますので、行だけ考えると
シートの最終行６５５３６行に５０行プラスした行を指定したことになりエラー


更に今後のためにいうと、
仮に、上記でエラーの出ない許容範囲、仮に、Range("B1:B10")だとしても

With Range("B1:B10)
　　IF .Offset(50,0) = .offset(49,0) then

このように複数のセルの値を比較することはできません。
ここでもエラーでます。
　
'---------------------------------------------------
Sub Sample()
　Dim i As Long
　For i = Range("A1").CurrentRegion.Rows.Count To 1 Step -1
　　　If Cells(i,"B").value = Cells(i-1, "B").Value Then
　　　　　Cells(i, "B").EntireRow.Delete
　　　End If
　Next i
End Sub
'-------------------------------------------------　
　

この回答への補足

丁寧なご説明ありがとうございます。
下記のサンプルを試すとエラーがでました。
サンプルに複数のシートを対応させると試しに書いてみましたが
エラーでした・・・難しいですね・・・

Sub Sample()
　Dim i As Long
　For i = Range("A1").CurrentRegion.Rows.Count To 1 Step -1
　　　If Cells(i,"B").value = Cells(i-1, "B").Value Then
　　　　　Cells(i, "B").EntireRow.Delete
　　　End If
　Next i
End Sub

補足日時：2009/02/18 18:03

No.4 回答者： web2525 回答日時： 2009/02/18 15:37

With Range("B:B")に対して

.Offset(i, 0)と指定している部分がまずいのだと思います。

No.3 回答者： hallo-2007 回答日時： 2009/02/18 15:27

ご希望の動きになるかわかりませんが、

For i = .CurrentRegion.Rows.Count To 2 Step -1
If .Cells(i, 2) = .Cells(i - 1, 2) Then .Cells(i, 2).EntireRow.Delete
Next i
エラーの訂正なら、といったことでしょうか。

No.2 回答者： n-jun 回答日時： 2009/02/18 15:22

Ｂ列が重複している”行”を削除するというのは、Ａ列やＣ列以降にはデータがないのでしょうか？

ようはＢ列の重複を消す場合に、他の列が削除に関連するかどうかですけど。

しない（Ｂ列のみデータがある）ならフィルタオプションでしょうか。
http://www.eurus.dti.ne.jp/~yoneyama/Excel/filte …
とか。

この回答への補足

A列もC列もデーターはありますが、B列に重複があれば、重複しているデーターを一つ残して（A列とC列のデーターは保存）行ごと削除です。

補足日時：2009/02/18 15:51

No.1 回答者： marbin 回答日時： 2009/02/18 15:13

直接の回答ではないですが。

フィルタオプションの設定を使う
Dictionaryを使って重複無し配列を作成

などの方法で重複なしリストを作成できます。