条件にて行削除をするをマクロで高速化したい

シート（最初）のA,B,C列を連結した値と
シート（残）のA,B,C列を連結した値を照合させ
同じ値の場合は
シート（残）の該当行を削除です。
シート（最初）は6,182行
シート（残）は7,561行です。
VLookupを使って処理時間5分です。
VLookupを使わない記述で25分です。
20,000行位のデータを処理したいのですが時間が不安です。
別スレで
「VLookupで処理3分をdictionaryオブジェクトで1秒以内にする方法」を
教えていただきましたが、流用ができません。
シート（残）内にもシート（最初）内にも重複行はありません。
私の記述は「F列を検索用に使用」となっていて
F列にデータがある場合、都度記述を書換えないと
使えないので、そこも対応したいです。
照合させる値はA,B,Cの連結値というのは変わらないのですが
データがある範囲は都度変化する為です。
・A～E列とかA～H列とか
・シート残はA～E列、シート最初はA～G列とか
記述そのものを教えてください。よろしくお願いします。

Sub 自動重複削除F列使用()
'シート（最初）のA,B,C列とシート（残）のA,B,C列が一致した行は
'シート残の行を削除
'F列を検索値として使用。
Dim Line As Long
Dim LastRow As Long
Dim myRange As Range
Dim Flag
'シート「最初」のF1に、A,B,C列を結合した値を転記
With Sheets("最初")
Set myRange = .Range("F2:F" & .Cells(Rows.Count, "A").End(xlUp).Row)
.Range("F2").FormulaR1C1 = "=RC[-5]&RC[-4]&RC[-3]"
'シート「最初」のF2からデータのあるところまで
'F1の規則でデータ貼付
.Range("F2").AutoFill Destination:=myRange
End With
'シート「残」のF1に、A,B,C列を結合した値を転記
Sheets("残").Select
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
Range("F2").FormulaR1C1 = "=RC[-5]&RC[-4]&RC[-3]"
'シート「最初」のF2からデータのあるところまで
'F1の規則でデータ貼付
Range("F2").AutoFill Destination:=Range("F2:F" & LastRow)
On Error Resume Next
'双方のシートのF列を照合させ、ヒットした行は
'シート「残」から行削除をする
For Line = LastRow To 2 Step -1
Flag = WorksheetFunction.VLookup(Cells(Line, 6).Value, myRange, 1, 0)
If Err.Number = 0 Then
Rows(Line).Delete xlUp
Else
Err.Clear
End If
Next Line
'検索に使用したＦ列を削除
Sheets("残").Select
Columns("F:F").Select
Selection.Delete Shift:=xlToLeft
Sheets("最初").Select
Columns("F:F").Select
Selection.Delete Shift:=xlToLeft
Sheets("残").Select
Range("A1").Select
End Sub

●別方法
Sub 自動重複行削除F列未使用超遅()
'VLOOKUP無
'シート（最初）のA,B,C列とシート（残）の
'A,B,C列が一致した行はシート（残）の行を削除
Dim ws1, ws2 As Worksheet
Dim i, j As Long
Set ws1 = Worksheets("最初")
Set ws2 = Worksheets("残")
For i = 2 To ws1.Cells(Rows.Count, 1).End(xlUp).Row
For j = ws2.Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
If ws1.Cells(i, 1) = ws2.Cells(j, 1) And ws1.Cells(i, 2) = ws2.Cells(j, 2) And _
ws1.Cells(i, 3) = ws2.Cells(j, 3) Then
ws2.Rows(j).Delete (xlUp)
End

No.9 回答者： rukuku 回答日時： 2011/01/20 23:09

こんばんは

実際のデータでのスピードの検証はしていないのですが
Couontif関数
が使えるかもしれません。

シート（最初）とシート（残）のZ列にそれぞれ
ABCを連結した値を入れておきます。

シート（残）のAA2に
=COUNTIF(最初!Z:Z,残!Z2)
以下オートフィル
としますと、シート（最初）と重複なしなら0、あれば1以上となります。

オートフィルタを使用すれば、０の行を抽出できますので、別のシートやブックに抽出結果をコピー＆ペーストします。

この回答への補足

これは基幹システムが自動ではきだしたデータです。
でセルの書式設定は全て標準です。

B,C列は必ず数字4ケタです。
ただし「数値が文字列として保存されています」
となっています。
A列は英数字混在で10桁～14桁です。
で数字のみの場合も有り、
同じく「数値が文字列として保存されています」となっています。

このA列が数字のみで「数値が文字列として保存されています」と
なっていると、
=COUNTIF(最初!Z:Z,残!Z2)
以下オートフィルで、
シート（最初）と重複なしなら0、あれば1以上が
重複なのに0になってしまい漏れてしまいます。

また
シート最初が10,046行
シートが11,425行だと
=COUNTIF(最初!Z:Z,残!Z2)
以下オートフィル
した時にCPU使用率１００％でしばらくＰＣが
はまってしまいました。
どうもありがとうございました。

補足日時：2011/01/21 09:55

この回答へのお礼

マクロ作成以前はこの方法をマニュアルで行っていました。
・シート（最初）と重複なしなら0、あれば1
　が精度が悪く漏れがある
・計算式を入れて値が出たら
　値貼付で式を消さないと、シート最初→シート残に
　動かすと「再計算」でしばらくとまる
・同じく計算式で出た列の値優先で並び変えて
　１の行だけを一気に削除の時、
　「再計算」となる

などで使用者から
「値貼付って意味わからないし他の編集作業のように
　ボタン1個クリックでできるようにしてほしい」
と言われてマクロにしました。

どうもありがとうございます。

お礼日時：2011/01/21 09:14

No.8 回答者： end-u 回答日時： 2011/01/20 15:14

>・１件ずつ重複チェックをするのではなく別作業列に数式を入れてまとめてチェックする。

ここ、遅いですね。使い物にならないです。失礼しました..orz
この部分だけDictionaryを使った折衷案。
#シート名やデータ範囲などは実状に合わせて適宜、手を入れてください。

Sub try_1()
　　'VBE[ツール]-[参照設定]で"Microsoft Scripting Runtime"参照
　　Dim dic As Dictionary
　　Dim r1　As Range　　 '照合元（残）
　　Dim r2　As Range　　 '照合先（最初）
　　Dim r　 As Range　　 '削除起点
　　Dim i　 As Long
　　Dim v() As Variant　 '照合元
　　Dim w() As Variant　 '照合先
　　Dim flg() As Boolean '照合結果

　　'データ範囲のIV列を取得
　　With Sheets("sheet1").Range("A1").CurrentRegion.EntireRow
　　　　Set r1 = Intersect(.Cells, .Offset(1), .Columns("IV"))
　　End With
　　With Sheets("sheet2").Range("A1").CurrentRegion.EntireRow
　　　　Set r2 = Intersect(.Cells, .Offset(1), .Columns("IV"))
　　End With
　　r1.Formula = "=A2&B2&C2"
　　v() = r1.Value
　　ReDim flg(1 To UBound(v), 0) As Boolean
　　r1.ClearContents
　　r2.Formula = "=A2&B2&C2"
　　w() = r2.Value
　　'作業列削除
　　r2.EntireColumn.Delete

　　Set dic = New Dictionary
　　'Dictionaryに照合先を登録
　　For i = 1 To UBound(w)
　　　　dic(CStr(w(i, 1))) = Empty
　　Next
　　'照合元と照合先の重複チェック
　　For i = 1 To UBound(v)
　　　　flg(i, 0) = dic.Exists(CStr(v(i, 1)))
　　Next
　　'照合結果をIV列に書き戻し
　　r1.Value = flg()

　　'データ範囲のみソート
　　r1.EntireRow.Sort Key1:=r1.Item(1), _
　　　　　　　　　　　Order1:=xlAscending, _
　　　　　　　　　　　Header:=xlNo, _
　　　　　　　　　　　OrderCustom:=1, _
　　　　　　　　　　　Orientation:=xlTopToBottom
　　'重複データの先頭を検索
　　Set r = r1.Find(What:="TRUE", _
　　　　　　　　　　LookIn:=xlValues, _
　　　　　　　　　　LookAt:=xlWhole)

　　If Not r Is Nothing Then
　　　　'重複データあれば行全体削除
　　　　Range(r, r1(r1.Count)).EntireRow.Delete
　　End If
　　'作業列削除
　　r1.EntireColumn.Delete

　　Set dic = Nothing
　　Set r1 = Nothing
　　Set r2 = Nothing
　　Set r = Nothing
End Sub

最速ではないです。速度より理解し易さ重視..（多分。
理解した上でなら、メンテナンスもそんなに大変じゃないと思います。

この回答へのお礼

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

コンパイルエラー
ユーザー定義型は定義されていません

Dim dic As Dictionaryでとまります。

'VBE[ツール]-[参照設定]で"Microsoft Scripting Runtime"参照
↓
参照可能なライブラリファイル
で
Microsoft Scripting Runtime
というのは無かったのですが．．．．．


初めて開くウィンドーですし
ユーザー定義型？
全然分かりません。

＞理解した上でなら

理解は私では難しそうです。
申し訳ありません。

お礼日時：2011/01/24 10:24

No.7 回答者： hananoppo 回答日時： 2011/01/20 14:39

こんな感じでいかがでしょう。

Sub Sample()
Dim LastNum As Long
Dim Data() As String, aData As String
Dim rNum1 As Long, rNum2 As Long

Application.ScreenUpdating = False
Worksheets("最初").Activate
LastNum = Cells(Rows.Count, 1).End(xlUp).Row
ReDim Data(2 To LastNum)
For rNum1 = 2 To LastNum
Data(rNum1) = Cells(rNum1, 1).Value & Cells(rNum1, 2).Value & Cells(rNum1, 3).Value
Next rNum1
Worksheets("残").Activate
For rNum2 = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
aData = Cells(rNum2, 1).Value & Cells(rNum2, 2).Value & Cells(rNum2, 3).Value
For rNum1 = 2 To LastNum
If Data(rNum1) = aData Then
Rows(rNum2).Delete
Data(rNum1) = Data(LastNum)
LastNum = LastNum - 1
Exit For
End If
Next rNum1
Next rNum2
Application.ScreenUpdating = True
End Sub

この回答への補足

シート最初　10,046行
シート残　　11,425行
とデータが増えたら
約20秒と処理時間が長くなりました。

でも素晴らしいです。
どうもありがとうございました。

ただ記述にコメントを入れたいのですが
どの分が何をしているのか分からず
入れれないです。すいません。

補足日時：2011/01/21 09:27

この回答へのお礼

私のＶＬＯＯＫＵＰと同じ処理結果でかつ
1秒かかりませんでした。
20,000行でも挑戦してみます。
どうもありがとうございました。

お礼日時：2011/01/20 17:58

No.6 回答者： layy 回答日時： 2011/01/20 14:12

照合するキーがあるならエクセルに決めてかかる必要性はありません。

アクセスでもＣＳＶファイルでも照合はできます。

１つのシートにて、合わせた14000行近くで最初と残の区別がつけばそれでも照合可能です。

決められた時間内にしなければいけないのか？、処理時間に不安げなのはよくわかりませんけど。

この回答へのお礼

すいません。
エクセルがまだよく使えません。
アクセスは無理です。
処理時間についてですが自分で作成した
ＶＬＯＯＫＵＰは5分です。
よって20,000行だと15分かなと。
その間CPU使用率が100%で他の操作は出来ませんし
また以前ここでVLOOKUPを1秒以内にしてもらった事が
あるので出来るのかなと質問しました。
(ただしその時は値を返して転記で行削除ではなかったです。）
どうもありがとうございました。

お礼日時：2011/01/20 17:56

No.5 回答者： merlionXX 回答日時： 2011/01/20 13:57

条件により行を削除するのを、実際に削除するのではなく一旦配列に入れて早くする方法は

http://oshiete.goo.ne.jp/qa/6404265.html
でも、その前にもお見せしたと思いますが・・・・・・・・。

これでいかがですか？
実際に行を削除しているわけではないので、行により書式が違ったりすると変な感じになってしまいますが。

Sub test01()
　　Dim myS, myZ, myX
　　Dim i As Long, j As Long, n As Long, m As Long
　　Dim buf As Boolean
　　Dim zz As String, ss As String
　　With Sheets("最初")
　　　　myS = .Range("A2:C" & .Cells(Rows.Count, "A").End(xlUp).Row).Value
　　End With
　　With Sheets("残")
　　　　myZ = .Range("A2:C" & .Cells(Rows.Count, "A").End(xlUp).Row).Value
　　End With
　　ReDim myX(1 To UBound(myZ, 1), 1 To UBound(myZ, 2))
　　For i = 1 To UBound(myZ, 1)
　　　　buf = False
　　　　zz = ""
　　　　For j = 1 To UBound(myZ, 2)
　　　　　　zz = zz & myZ(i, j)
　　　　Next j
　　　　For n = 1 To UBound(myS, 1)
　　　　　　ss = ""
　　　　　　For j = 1 To UBound(myS, 2)
　　　　　　　　ss = ss & myS(n, j)
　　　　　　Next j
　　　　　　If zz = ss Then
　　　　　　　　buf = True
　　　　　　　　Exit For
　　　　　　End If
　　　　Next n
　　　　If Not buf Then
　　　　　　m = m + 1
　　　　　　For j = 1 To UBound(myZ, 2)
　　　　　　　　myX(m, j) = myZ(i, j)
　　　　　　Next j
　　　　End If
　　Next i
　　With Sheets("残")
　　　　.Range("A2:C" & .Cells(Rows.Count, "A").End(xlUp).Row).ClearContents
　　　　.Range("A2").Resize(m, UBound(myZ, 2)).Value = myX
　　End With
End Sub

この回答への補足

>削除されるべき行が残ったり、
>削除されてはいけない行が残ったり。
↓
削除されるべき行が残ったり、
削除されてはいけない行が削除されたりです。

またお礼に誤解を招く内容がありました。

私が別スレで教えていただいた物を改造した場合と
今回教えていただいた物の処理結果が
同じように読取れてしまいます。
そうではありませんでした。m(__)m

私の改造版の方が程度が悪いです。
merlionXXさんに今回教えていただいた方が
内容がはっきりしています。

まずシート（残）は1行も削除されておらず７，５６１行
そのまま残っています。
（１，３７９行だけ残る予定です。
　項目行を入れると１，３８０行目。）
Ａ～Ｅ列までデータがありますが
１３８０行目まではＡ～Ｅ列まで全部データがありますが
１３８１行目から７，５６１行までは
Ａ，Ｂ，Ｃ列の値がなくなりＤ，Ｅ列の値だけになっています。
処理時間は約１分です。
申し訳ありませんでした。

補足日時：2011/01/20 18:51

この回答へのお礼

＞その前にもお見せしたと思いますが・・・・・・・・。

はい。それを改造すれば出来るとたかをくくっていましたが
駄目でした。

削除されるべき行が残ったり、
削除されてはいけない行が残ったり。
また両シートとも
Ａ～Ｅ列のデータなのですが
残った行において
途中までは正常ですが途中から
列のとこどころのデータが消失しました。
よってギブアップで質問しました。
その動かない私が改造した記述では
回答者様に解析の時間をとらせてしまうので
自分で出来た思ったとうりに動く
ＶＬＯＯＫＵＰの記述を載せました。

merlionXXさんに教えていただいた記述で試したのですが
すでにお断りがありますが

＞実際に行を削除しているわけではないので、
＞行により書式が違ったりすると変な感じになってしまいますが。

のとうり、
削除されるべき行が残ったり、
削除されてはいけない行が残ったり。
また両シートとも
Ａ～Ｅ列のデータなのですが
残った行において途中までは正常ですが
途中から列のとこどころのデータが消失しました。
よく分かりません。m(__)m

どうもありがとうございました。

お礼日時：2011/01/20 17:52

No.4 回答者： end-u 回答日時： 2011/01/20 12:42

>記述そのものを教えてください。

よろしくお願いします。
まずは記述そのものではなくて考え方から。
なのでニーズがない場合はスルーしてください。

・連結値用に固定の未使用列を使う。
　（例えば最右のIV列）
・１件ずつ重複チェックをするのではなく別作業列に数式を入れてまとめてチェックする。
　（例えばIU列に=ISNUMBER(MATCH(IV2,Sheet2!$IV$2:$IV$20000,0))などの数式
　　Formulaプロパティを使えばダイレクトに指定できるので解かりやすい）
・１行ずつ削除するのではなく並べ替えてまとめて削除する。
　（IU列基準にソートして下のほうにTRUEがまとまるのでこれを削除）

ワークシート上での作業ですから、複数範囲にまとめて数式を入れたりソートを活用したり。
シート上のソートは速くて便利です。
まずはVBAのA。Applicationの長所を活かして実務を行えば良いのではないでしょうか。

前述の処理は基本的に「マクロの記録」でベースが録れます。
自分で理解した上でコーディングできるので応用も利きやすく、
今後の役にも立つのではないでしょうか。

この回答へのお礼

計算式を入れたのですが
処理が終わらずフリーズ状態になりました。
多分式の入れ方が悪いのだと思いますが
ちょっと手に負えませんでした。
どうもありがとうございました。

お礼日時：2011/01/20 17:45

No.3 回答者： D-Matsu 回答日時： 2011/01/20 11:33

A.SelectとSelection.Bを使わず、直接A.Bと書くことを意識するだけでもそこそこ速くなります。

これは、例えば以下のコードを
--
Sheets("残").Select
Columns("F:F").Select
Selection.Delete Shift:=xlToLeft
--

こう書きなおす、という事です。
--
Sheets("残").Columns("F:F").Delete Shift:=xlToLeft
--

Application.ScreenUpdating = falseは画面更新が完全に止まってしまいフリーズと見分けがつかなくなるので、最後の最後まではなるべく使わない方がいいと思います。確かにこれはよく効きますが。
あと、長時間かかる処理は適宜DoEventsを入れておくといいです。これは何らかのバグで無限ループに陥った時などにExcelを強制終了する必要がなくなるため。

この回答へのお礼

教えていただいた
とうり試して見ましたが
あまり速くはなりませんでした。
どうもありがとうございました。

お礼日時：2011/01/20 17:43

No.2 回答者： layy 回答日時： 2011/01/20 10:56

どんなことが遅い要因か、意識したらいいでしょう。

セルを選択するのがあちこち行く。
シートを跨ぐ。
行削除等で表示内容が変わる。
等が遅くさせると思えば良いです。

マウスカーソルが転々と動けば動くほど遅い。

最近は性能のおかげで早いのでしょうが、ロジックや記載変えるだけで無駄が無くなりさらに早くなることもあります。


行削除はしないで、削除する行にマーキング。マーキングした行を並び替えかフィルタでまとめた後で複数行をクリア。これだけでも早くなりますし、ＮＯ１さんの対処も早くする手段ですから両方やる。

この回答へのお礼

>削除する行にマーキング

この時にVLOOKUPを使いました。
マーキングしている処理の時に
時間がかかってあまり速くはなりませんでした。
どうもありがとうございました。

お礼日時：2011/01/20 17:41

No.1 回答者： FEX2053 回答日時： 2011/01/20 10:09

プログラムの先頭に

Application.ScreenUpdating = False

最後尾に

Application.ScreenUpdating = True

を入れて、処理中の画面更新を止めてみてはどうですか？

この回答へのお礼

よく指摘を受ける内容なのに忘れてました。
入れてみましたが
処理時間はかわりませんでした。
VLOOKUPの処理が重いです。
（マクロでなくても式を入れても重いです。）
どうもありがとうございました。

お礼日時：2011/01/20 11:54