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

Question

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

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

30246kiku · Accepted Answer

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 ファイルとかでしょうか？
これについては、状況がわからないと・・・

30246kiku · Answer

＃６です

＃７さんの結果を参考に 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

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

NotFound404 · Answer

回答じゃありません 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 でも
配列の確保・参照『まで』は問題なく出来ました。
質問者さんの反応がないけど・・・？
以上ご参考まで。

30246kiku · Answer

＃５です

＃４さんのサンプルデータの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 · Answer

＃３です

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

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

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

＃３での 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　１．２秒

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

NotFound404 · Answer

回答じゃありません。ショックだったもので。。。
こちらは２～３年くらい前の中堅クラスの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

nicotinism · Answer

35万件以上あるエクセルデータなので
Integer型の変数だと、32767 までしか格納できませんから
オーバーフローになります。

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

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

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

Picosoft · Answer

まず、オーバーフローの件について。
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

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

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

この回答への補足

＃６です

回答じゃありません II。

＃５です

＃３です

回答じゃありません。

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

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

似たような質問が見つかりました

このQ&Aを見た人はこんなQ&Aも見ています

関連するカテゴリからQ&Aを探す

このQ&Aを見た人がよく見るQ&A

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング