こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

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

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
'最終行が1行減ったのでlastRowの値を減らします。
lastRow = lastRow - 1
'チェックしている行を1行前に戻します。
j = j - 1
End If
Next j
Next i

End Sub

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

投稿日時 - 2014-07-24 23:43:31

QNo.8691314

すぐに回答ほしいです

質問者が選んだベストアンサー

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 値は変化しない事を利用し、
消す対象のセルを覚えておいて、
重複のチェックが終わったら、覚えていた重複していたものに対して一気に行削除

30万件で15秒くらい(環境によって大幅変動あると思います)

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 だけ使いたかったので、
消えても良い最終行+1のセルをダミー登録してからループに突入

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


【余談】

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

提示あった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行目:A
2行目:B
3行目:A
4行目:A

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

1行目:B
2行目:A
3行目:A

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

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

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


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

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

投稿日時 - 2014-07-26 07:49:17

補足

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

投稿日時 - 2014-08-04 10:12:13

お礼

30246kiku 様

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

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

投稿日時 - 2014-07-27 21:30:42

このQ&Aは役に立ちましたか?

7人が「このQ&Aが役に立った」と投票しています

回答(8)

ANo.8

#6です

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

同じデータではありませんが、812.5秒 → 113秒まで短縮されました。
ちなみに、私の方のサンプルデータでは、16秒 → 2.7秒に。

投稿日時 - 2014-07-27 09:48:22

お礼

30246kiku 様

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

投稿日時 - 2014-07-27 21:34:29

ANo.7

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

35万件あっても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

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

投稿日時 - 2014-07-26 21:08:21

お礼

NotFound404 様

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

投稿日時 - 2014-07-27 21:35:55

ANo.6

#5です

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

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

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

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

Samp1:ソート 4秒 その後の実行 1.5秒
Samp1:(未ソート)1.4秒
Samp3:266.5秒
Samp4:17.5秒


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


PS.

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

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

投稿日時 - 2014-07-26 18:18:03

お礼

30246kiku 様

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

投稿日時 - 2014-07-27 21:33:32

ANo.5

#3です

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

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

・サンプルデータの作成
2度やって平均 39秒

#3での Samp3 812.5秒
残った行数 343107

#3での Samp1 28.9秒
残った行数 343043

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


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

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

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

このデータを作るのが 152秒
このデータでは、Samp3 16秒  Samp1 1.2秒


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

投稿日時 - 2014-07-26 14:42:43

ANo.4

回答じゃありません。ショックだったもので。。。
こちらは2~3年くらい前の中堅クラスのPCだと思います。
下記で35万件のダミーデータを作成し
30246kiku さんのを試したところ・・・4分半位でした 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

投稿日時 - 2014-07-26 12:29:51

お礼

NotFound404様

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

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

投稿日時 - 2014-07-27 21:32:21

ANo.2

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

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

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

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

投稿日時 - 2014-07-25 10:33:15

お礼

nicotinism 様

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

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

投稿日時 - 2014-07-27 21:27:14

ANo.1

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

投稿日時 - 2014-07-25 09:33:17

お礼

Picosoft様

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

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

投稿日時 - 2014-07-27 21:25:50

あなたにオススメの質問