エクセルVBAについて質問です。

質問

現在、マクロで重複データを削除する処理しています。
一応動作はするのですが、すごく遅いです。
およそ私のPC（XPのQuadコア）で1行処理するのに約0.85秒かかっています。
データが1万行以上もあるようなときは、何時間もかかってしまいます。

エクセルのデータは、以下のように、
A列とB列に文字列が何行にも渡って入っているものです。

A列　　 B列
AAA BBB
CCC DDD
EEE FFF
GGG BBB
CCC HHH
CCC DDD
（以下同様）

上のようなシートで、A列とB列の両方について重複する行を削除したいと思っています。
上記例だと、一番最後の「CCC-DDD」の箇所を削除したいです。

そこで以下のようなマクロを組みました。
(1)はじめに重複をチェックする変数（A列・B列）を取得します。
(2)上から順にチェックを開始します。
(3)A列・B列双方が取得した変数と一緒なら重複カウンターに1を加える。
（1回目の出現では削除しない）
(4)チェックを続け、重複カウンターが2以上になった行は削除する。
(5)上記を空白行まで繰り返す。
というような流れです。

（マクロ記述の途中部分からです）
'重複する行を削除
counter3 = 1
Do
search_word1 = Cells(counter3, 1).Value
search_word2 = Cells(counter3, 2).Value
counter4 = 1
double_counter = 0
Do
If Cells(counter4, 1).Value = search_word1 And Cells(counter4, 2).Value = search_word2 Then
double_counter = double_counter + 1
If double_counter > 1 Then '二度以上出現した場合から削除する
Cells(counter4, 1).EntireRow.Delete
counter4 = counter4 - 1
End If
End If
counter4 = counter4 + 1
Loop Until Cells(counter4, 1).Value = ""
counter3 = counter3 + 1
Loop Until Cells(counter3, 1) = ""

初心者なのもので、冗長や不適切な箇所などあるかと思います。
より効率的、あるいは、より早くできる書き方がありましたら、
ぜひともお教え下さい・よろしくお願いします。

回答No.1

nattocurry · ベストアンサー

データをソートすれば、重複データは必ず上下に隣接することになるので、チェック回数を減らすことが出来ます。
データの並び順を変えたくないのであれば、新たにID列を設けて、上から順に連番を振っておき、A列とB列を基準にソートしてから重複行を削除して、最後にID順でソートし直せば良いです。

お礼

皆様、ご回答ありがとうございました。
お礼が遅れて大変申し訳ありません。

皆様の回答を参考に検討した結果、
nattocurry様のご回答が一番分かりやすかったので、
並べ替えをしてから、隣接する重複レンジを削除するものにしましたら、
実用的な時間で終わるようにすることができました。

ご丁寧なご回答感謝しております。
今後もよろしくお願いします。

回答No.5

米沢 栄蔵（@YON56）

マクロを組む前にデータ側で一手間掛けてはどうですか。
まず、C列に[=Ai&Bi],D列に[=COUNTIF(C$1:Ci,Ci)]と入力し、全データ分へコピー貼付します。
そして、D列の値が>1を検索し、削除するマクロを組めば、スピードアップは確実です。

お礼

皆様、ご回答ありがとうございました。
お礼が遅れて大変申し訳ありません。

皆様の回答を参考に検討した結果、
並べ替えをしてから、隣接する重複レンジを削除するものにしましたら、
実用的な時間で終わるようにすることができました。

ご丁寧なご回答感謝しております。
今後もよろしくお願いします。

回答No.4

nda23

自動更新、自動計算、イベントの抑止は#1の方の指摘通りです。
重複データの見つけ方ですが、ADOを使う方法があります。

Dim P, C, Q, S, A, B, K, L, X, Y, Z
'自身のパス名を取得
P = ThisWorkbook.Path
If Right(P, 1) <> "\" Then P = P & "\"
P = P & ThisWorkbook.Name
'ADO接続を作成
Set C = CreateObject("ADODB.Connection")
C.Provider = "Microsoft.Jet.OLEDB.4.0"
C.Properties("Extended Properties") = "Excel 8.0"
C.Open P
'対象シートの設定
Set S = ThisWorkbook.WorkSheets(1) '最初のシートの場合
'SQLとクエリ作成 ★"A列","B列"は列見出しで、実名に変えて下さい
P = "SELECT A列,B列,COUNT(*) AS 件数 FROM [" & S.Name & "$] " _
　& "GROUP BY A列,B列 HAVING COUNT(*)>1"
Set Q = C.Execute(P)
Do Until Q.EOF 'EOFになるまでのループ
　　A = Q.Fields(0).Value
　　B = Q.Fields(1).Value
　　K = Q.Fields(2).Value
　　'先頭から検索する
　　Set X = S.Columns("A:A").Find(What:=A, After:=S.Cells(2, 1))
)
　　Do
　　　　'次の行を検索
　　　　Set X = S.Columns("A:A").FindNext(After:=X)
　　　　L = X.Row '行位置
　　　　If S.Cells(L, 2) = B Then
　　　　　　'削除対象行を削除
　　　　　　Y = CStr(L)
　　　　　　S.Rows(Y & ":" & Y).Delete
　　　　　　K = k - 1
　　　　End If
　　Loop Until K = 1
　　'次のデータ
　　Q.MoveNext
Loop
Q.Close
C.Close

ポイントは以下の通りです。
(1)重複しているデータのみを収集する
(2)Findメソッドで対象を探す（セルをグルグルするより断然速い）

ただ、行数が少ない場合はクエリの時間がかかるので、素朴な方法の
方が速い場合もあります。何かの参考になれば幸いです。

お礼

皆様、ご回答ありがとうございました。
お礼が遅れて大変申し訳ありません。

皆様の回答を参考に検討した結果、
並べ替えをしてから、隣接する重複レンジを削除するものにしましたら、
実用的な時間で終わるようにすることができました。

初心者なもので、ご回答の内容がいまいちつかめませんでしたが、
ご丁寧なご回答感謝しております。
今後もよろしくお願いします。

回答No.3

AKARI0418

Excelのプロパティを操作することで実現できます。
共通していえることですが、必ず解除してから終わってください、画面が真っ白のままになったりします。もし解除できずに終わってしまいましたら、あわてず解除専用マクロを組んで解除してください。

１．表示の更新を自動で行わないようにする。
Application.ScreenUpdating = false
処理
Application.ScreenUpdating = true

２．セル内の計算を自動で行わないようにする。
Application.Calculation = xlCalculationManual
処理
Application.Calculation = xlCalculationAutomatic

３．イベント発生の抑止
Application.EnableEvents = False
処理
Application.EnableEvents = true

お勧めは１と２を組み合わせて使うと速度が大幅に改善されます。
当初のマクロに組み込んで試してみてください、違いが実感できると思います。
Application.ScreenUpdating = false
Application.Calculation = xlCalculationManual
処理
Application.ScreenUpdating = true
Application.Calculation = xlCalculationAutomatic

ソースの組み方としてはまずチェック対象をオブジェクトにセットすることです。
これにより参照先の特定の回数が減り高速化されます。
例
dim rng as Range
Set rng = Range(Cells(1, 1), _
Range(ActiveSheet.Cells(65536, 2), _
ActiveSheet.Cells(65536, 2)).End(xlUp))
search_word1 = rng.Cells(counter3, 1).Value
となります。

Scripting.Dictionaryを使用しループ回数を減らします。
Microsoft.Scripting.Runtimeを参照設定すること
Dim List As New Scripting.Dictionary
これは重複データをはじくことができます。
'すでに名前が登録されているかをチェック
strBuf = Cells(counter3, 1).Value & "," & Cells(counter3, 2).Value
If List.Exists(strbuf) = False Then
List.Add(strbuf,"今回はアイテムは使用しません")
Else
Cells(counter4, 1).EntireRow.Delete
End if

お礼

皆様、ご回答ありがとうございました。
お礼が遅れて大変申し訳ありません。

皆様の回答を参考に検討した結果、
並べ替えをしてから、隣接する重複レンジを削除するものにしましたら、
実用的な時間で終わるようにすることができました。

ご丁寧なご回答感謝しております。
今後もよろしくお願いします。

回答No.2

redfox63

Excelに重複行の削除をやらせてしまってはどうでしょう

A/B列のデータ範囲の冒頭に題目を記述
DATA-A DATA-B などと

D/E列に同様に DATDA-A DATA-Bと記述

A/B列のどこかのセルを選択して CTRL+(テンキーの)*
メニューから データ > フィルター > フィルターのオプションの設定
指定した範囲を選択
検索条件範囲を D1:E1
抽出範囲を D1:E1
重複するレコードを無視するのチェックをONにして
OKをクリック

といった手順をマクロの記録などを使ってみましょう

お礼

皆様、ご回答ありがとうございました。
お礼が遅れて大変申し訳ありません。

皆様の回答を参考に検討した結果、
並べ替えをしてから、隣接する重複レンジを削除するものにしましたら、
実用的な時間で終わるようにすることができました。

ご丁寧なご回答感謝しております。
今後もよろしくお願いします。