マクロでファイルを読み込み、重複行を削除したい。

35万件以上あるエクセルデータに対して、マクロを使って以下のような処理で重複業を削除したいと思っています。

Sub DeleteOldRow()
Dim lastRow As Integer
Dim i As Integer
Dim j As Integer
Dim strVal As String
'B列の最終行を求めます。
lastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, 2).End(xlUp).Row
'1行目から最終行の前まで繰り返します。
For i = 1 To lastRow - 1
'チェックする値を、strValに代入します。
strVal = ActiveSheet.Cells(i, 2).Value
'今見てる行から、下をチェックします。
For j = i + 1 To lastRow
'もし、値が同じであれば、
If strVal = ActiveSheet.Cells(j, 2).Value Then
'元の行を削除します
ActiveSheet.Rows(i).Delete
'最終行が１行減ったのでlastRowの値を減らします。
lastRow = lastRow - 1
'チェックしている行を１行前に戻します。
j = j - 1
End If
Next j
Next i

End Sub

上記処理を３５万件あるファイル上でマクロの実行すると、オーバーフローしてしまいました。マクロ側で対象ファイルを読み込むなどして、処理を軽くするやり方はありますでしょうか。上記処理にどのような処理を加えればスムーズに処理されるでしょうか。

No.3 ベストアンサー 回答者： 30246kiku 回答日時： 2014/07/26 07:49

2007 にも「重複の削除」はありますよ。

VBA で記述してみると以下の様な感じです。

Public Sub Samp1()
　　Cells.RemoveDuplicates Array(2)
End Sub

上記では行全部消えますけど、他の列に影響しない指定もできるようです。
以下は B, C 列を対象にして、Array 部分にはその対象の何番目を指定する様です。

Public Sub Samp2()
　　Columns("B:C").RemoveDuplicates Array(1)
End Sub

ただ、質問者さんがやりたそうな事は、
・重複したら前の方を消す・・・
みたいで、上記「重複の削除」では、前の方を残すものの様です。
残したいものを前にするようなソートしてからなら、一番速そうです。

前の方を消す場合は、後ろの方から重複を確認して、重複するものだったら消す。
以下の様に考えます。

重複のチェックには Dictionary のキーを利用します。
無条件でキーを登録し、
重複した場合、前後の Count 値は変化しない事を利用し、
消す対象のセルを覚えておいて、
重複のチェックが終わったら、覚えていた重複していたものに対して一気に行削除

３０万件で１５秒くらい（環境によって大幅変動あると思います）

Public Sub Samp3()
　　Dim dic As Object
　　Dim rng As Range
　　Dim iRow As Long, i As Long

　　Application.ScreenUpdating = False
　　Set dic = CreateObject("Scripting.Dictionary")
　　iRow = Cells(Rows.Count, 2).End(xlUp).Row
　　Set rng = Cells(iRow + 1, 2)
　　While (iRow > 0)
　　　　i = dic.Count
　　　　dic(Cells(iRow, 2).Value) = Null
　　　　If (i = dic.Count) Then
　　　　　　Set rng = Union(rng, Cells(iRow, 2))
　　　　End If
　　　　iRow = iRow - 1
　　Wend
　　rng.EntireRow.Delete
　　Set rng = Nothing
　　Set dic = Nothing
　　Application.ScreenUpdating = True
End Sub

※ ループの中では Union だけ使いたかったので、
消えても良い最終行＋１のセルをダミー登録してからループに突入

※ Union で覚えて一気に削除していましたが、覚える事はしないで
　　　　If (i = dic.Count) Then
　　　　　　Rows(iRow).Delete
　　　　End If
と、１行毎に削除しても結果は同じになりますが・・・
気長に処理が終わるのを待ってください・・・　それだけ遅くなります


【余談】

> 上記処理にどのような処理を加えればスムーズに処理されるでしょうか。

提示あったVBA記述を見て、危ない所を何箇所か・・・・

★ ループ条件を考えてみる

Public Sub test1()
　　Dim i As Long, j As Long

　　j = 3
　　For i = 1 To j
　　　　Debug.Print i, j
　　　　If (i = 1) Then j = j - 1
　　Next
End Sub

上記のような記述がみられますが、出力された i, j はどうなっていたでしょうか？
For 文が解釈された時点で、ループ回数は決まってしまうので、
途中でループ条件を変更しても無意味

途中でループ条件を変えて動きたいのであれば、While 等で毎回判別する様に

Public Sub test1k()
　　Dim i As Long, j As Long

　　j = 3
　　i = 1
　　While (i <= j)
　　　　Debug.Print i, j
　　　　If (i = 1) Then j = j - 1
　　　　i = i + 1
　　Wend
End Sub

★ 行を削除した時をキッチリとイメージする

1行目：Ａ
2行目：Ｂ
3行目：Ａ
4行目：Ａ

だった時、i=1, j=3 で、1行目を削除するみたいですが

1行目：Ｂ
2行目：Ａ
3行目：Ａ

になって、また i=1, j=3 で、さらに1行目を削除しようとしていませんか？

少なくとも１行目を削除した時には、j の For 文は抜ける？？？
また、i = i - 1　も必要？？？

For 文で指定した変数（i とか j）は、いじらない方が良いと思います。
いじるのなら For 文はやめて、While 等に書き換えるとか・・・


> マクロ側で対象ファイルを読み込むなどして

元は CSV ファイルとかでしょうか？
これについては、状況がわからないと・・・

この回答への補足

Script Dictioaryで劇的に速くなりました！

補足日時：2014/08/04 10:12

この回答へのお礼

30246kiku　様

ご丁寧に解説いただきありがとうございます。
またお返事が遅くなり大変申し訳ございませんでした。

余談の部分についても大変勉強になります！
サンプルソースもしっかりと読ませて頂きます。

お礼日時：2014/07/27 21:30

No.8 回答者： 30246kiku 回答日時： 2014/07/27 09:48

＃６です

＃７さんの結果を参考に Samp3 を書き換えました

Public Sub Samp5()
　　Dim dic As Object
　　Dim iRow As Long, i As Long
　　Dim v As Variant

　　Application.ScreenUpdating = False
　　Set dic = CreateObject("Scripting.Dictionary")
　　With Range("B1", Cells(Rows.Count, "B").End(xlUp))
　　　　v = .Value
　　　　For iRow = UBound(v) To 1 Step -1
　　　　　　i = dic.Count
　　　　　　dic(v(iRow, 1)) = Null
　　　　　　If (i = dic.Count) Then v(iRow, 1) = Empty
　　　　Next
　　　　.Value = v
　　　　On Error Resume Next
　　　　.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
　　End With
　　Set dic = Nothing
　　Application.ScreenUpdating = True
End Sub

同じデータではありませんが、８１２．５秒 → １１３秒まで短縮されました。
ちなみに、私の方のサンプルデータでは、１６秒 → ２．７秒に。

この回答へのお礼

30246kiku　様

なんどもご丁寧な回答ありがとうございます。

お礼日時：2014/07/27 21:34

No.7 回答者： NotFound404 回答日時： 2014/07/26 21:08

回答じゃありません II。

30246kiku さん、わたしメの投稿にお付き合い頂きありがとうございます。

３５万件あってもExcelのソートは速いので、ダミーデータ作成ももうチョット・・・
と思って検索、
田中氏の
http://officetanaka.net/Excel/vba/speed/index.htm
を参考にしまして

Sub SampMakeData2()
Dim i As Long, j As Long, str As String
Dim v As Variant
Const rCount As Long = 350000 '実使用行数の代わりに決め打ちしてます
Application.ScreenUpdating = False
ReDim v(1 To rCount, 1 To 2)
For i = 1 To rCount
For j = 1 To 5
str = str & Chr(Int(Rnd() * 26) + 65)
Next j
v(i, 1) = i
v(i, 2) = str
str = ""
Next i
Range("A1:B350000") = v
Application.ScreenUpdating = True
Beep
End Sub

だと処理速度が１/４くらいに短縮されました。
ここまで大きな配列を扱ったことが無かったのですが
問題なさそうです。
限界はいずこに有りや？？？
引退PCのWinXP & Excel2002 & メモリ 1GB でも
配列の確保・参照『まで』は問題なく出来ました。
質問者さんの反応がないけど・・・？
以上ご参考まで。

この回答へのお礼

NotFound404　様

ご返信が遅くなって大変申し訳ございませんでした。

お礼日時：2014/07/27 21:35

No.6 回答者： 30246kiku 回答日時： 2014/07/26 18:18

＃５です

＃４さんのサンプルデータのA列の値を使えば前後関係がわかるようなので、
そのような列があったら・・・という事でもう１つ処理を

Excelファイルの拡張子が xlsm とした場合のものになりますが・・・

Public Sub Samp4()
　　Dim cn As Object, rs As Object
　　Dim sSql As String, sS As String

　　Application.ScreenUpdating = False
　　sS = ActiveSheet.Name
　　Set cn = CreateObject("ADODB.Connection")
　　cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" _
　　　　　　& "Data Source=" & ThisWorkbook.FullName & ";" _
　　　　　　& "Extended Properties='Excel 12.0 Xml;HDR=No'"

　　sSql = "SELECT Q1.* FROM [{%1}$] AS Q1 INNER JOIN " _
　　　　　　& "(SELECT Max(F1) AS AA FROM [{%1}$] GROUP BY F2) AS Q2 " _
　　　　　　& "ON Q1.F1=Q2.AA;"
　　Set rs = cn.Execute(Replace(sSql, "{%1}", sS))

　　Cells.ClearContents
　　If (Not rs.EOF) Then Range("A1").CopyFromRecordset rs
　　rs.Close: Set rs = Nothing
　　cn.Close: Set cn = Nothing
　　Application.ScreenUpdating = True
End Sub

これでやると ６４秒でしたね
ただ、使用している列数は A,B の２列だけなので、列数が多くなったら？？？

５文字ではなく２文字にしてもう一度測定してみると

Samp1：ソート　４秒　その後の実行　１．５秒
Samp1：（未ソート）１．４秒
Samp3：２６６．５秒
Samp4：１７．５秒


以上　何かの参考になればと・・・


PS.

＃３にて
> > マクロ側で対象ファイルを読み込むなどして
>
> 元は CSV ファイルとかでしょうか？
> これについては、状況がわからないと・・・

と記述していたのは、
もし CSVファイルだったら Excel に読み込んでからではなく、
Samp4 の方法で直接 CSV 操作できるかな・・・
というのがあったので・・・

この回答へのお礼

30246kiku　様

読み込むファイルはCSVになります。

お礼日時：2014/07/27 21:33

No.5 回答者： 30246kiku 回答日時： 2014/07/26 14:42

＃３です

処理性能は環境によって大幅変動しましたね
秒数は記述しない方が良かったですね

＃４さん提示のサンプルデータ作成を使用してやってみた結果をご報告します。

・サンプルデータの作成
２度やって平均 ３９秒

＃３での Samp3　８１２．５秒
残った行数　３４３１０７

＃３での Samp1　２８．９秒
残った行数　３４３０４３

※ 同じデータでやっとけばよかったと後悔（再度・・・断念）


私が使っていたサンプル作成用を３５万件に

Public Sub textData()
　　Dim r As Range
　　Dim st As Single

　　st = Timer()
　　Application.ScreenUpdating = False
　　For Each r In Range("A1:G350000")
　　　　Select Case r.Column
　　　　　　Case 2
　　　　　　　　r.Value = r.Row Mod 100
　　　　　　Case Else
　　　　　　　　r.Value = r.Address(False, False)
　　　　End Select
　　Next
　　Columns.AutoFit
　　Application.ScreenUpdating = True
　　MsgBox Timer() - st & " 秒"
End Sub

※ みてわかると思いますが、残る行数 １００　且つ　比較する所は数値

このデータを作るのが　１５２秒
このデータでは、Samp3 １６秒　　Samp1　１．２秒


※ 何がどうで・・・考察は各自でお願い致します。
現状では同じ傾向のあるサンプルは作れないのかな・・・と思います。

No.4 回答者： NotFound404 回答日時： 2014/07/26 12:29

回答じゃありません。

ショックだったもので。。。
こちらは２～３年くらい前の中堅クラスのPCだと思います。
下記で３５万件のダミーデータを作成し
30246kiku さんのを試したところ・・・４分半位でした orz

Sub SampMakeData()
Dim i As Long, j As Long, str As String
Application.ScreenUpdating = False
For i = 1 To 350000
For j = 1 To 5
str = str & Chr(Int(Rnd() * 26) + 65)
Next j
Cells(i, 1) = i
Cells(i, 2) = str
str = ""
Next i
Application.ScreenUpdating = True
Beep
End Sub

この回答へのお礼

NotFound404様

ご連絡ありがとうございます。
ご返信が遅くなり大変申し訳ありませんでした。

ダミーデータで検証も頂いたようで大変参考になります。

お礼日時：2014/07/27 21:32

No.2 回答者： nicotinism 回答日時： 2014/07/25 10:33

35万件以上あるエクセルデータなので

Integer型の変数だと、32767 までしか格納できませんから
オーバーフローになります。

データ型をIntegerからLong型に修正して
日本郵便の郵便番号データ（１２万件ちょっと）で
走らせると見事に「応答なし」になって１分経っても変化なし。

二重ループで行を総なめに近いことをやっている。
発見する都度、行を削除していますので直接関係ないセルのアドレスまで
移動しなければならずExcel中で変換作業が入って非効率。
なので
予めセルを並び替えてしまい、
セルの値が変わるまで、Do ～ Loop
重複発見の列は、Delete ではなくてClearContents で中身だけ削除。
中身の削除処理が終わったら
ジャンプ（Ctrl+G） → 空白セルを選択 → 削除
をマクロで行えば少しはマシになるかもしれません。
試してません。

が、Excel2010には、データタブ→「重複の削除」があります。
2007にもある・・？
これで行うとあっという間に終わりました。Excel恐るべし。
勉強のためではなく、仕事で必要なら
マクロよりも「重複の削除」が時短になりますね。

この回答へのお礼

nicotinism 様

ご回答ありがとうございます。
お返事が遅くなり大変申し訳ございませんでした。

重複の削除で試してみたのですが、期待通りの結果にならなかったので、断念しました。

お礼日時：2014/07/27 21:27

No.1 回答者： Picosoft 回答日時： 2014/07/25 09:33

まず、オーバーフローの件について。

Integer型は最大で32767までの数字しか扱えません。
lastRow, i, jはLong型で宣言してください。

http://excelvba.pc-users.net/fol5/5_2.html


次に、アルゴリズムについてですが、
「今見ている行と、それより下の行とをすべて比較する」という方式だと、
比較回数が最大で
　349999 + 349998 + 349997 + …… + 3 + 2 + 1 = 約612億 (回)
になり、かなりの時間がかかると思われます。

「今見ている行のデータが、今まで見たことのあるデータなら削除する」という方式にすると、
比較回数が35万回程度で済みます。
以下のサイトを参考に作ってみてください。
http://officetanaka.net/excel/vba/tips/tips80.htm

この回答へのお礼

Picosoft様

ご回答ありがとうございます。
またご返信が遅くなり大変申し訳ありませんでした。

やはり35万の二乗ってのは無理がありますよね。。。
参考サイトのご提示ありがとうございます。

お礼日時：2014/07/27 21:25