| |
▼勉強中さっち さん：
>>毎回削除するのではなく、最後にまとめて削除するように改良するだけでも
>>格段の進歩ですよ (^^
>
>そうですね。
>まとめて削除するなら、削除行をまとめる入れ物作成して、最終的に
>入れ物.DELETEとすれば、いけますよね。
>配列を設定して、ReDim Preserveで格納されている削除行を失わなければ
>最終的に一撃で削除できますよね？
>
>その方が、処理速度があがるのでしょうか？
スピード実験してみました
テストは 「Org」という5100行×8列 の表の入ったシートを、コピーして
コピーシートの方で、方法による処理スピードをテストしたものです。
'まず、下から対象行を一行づつ削除する方法
Sub Test1_Del_OnDemand()
'範囲をソートする
Worksheets("Org").Copy After:=Sheets(Sheets.Count)
Range("A1").CurrentRegion.Sort Key1:=[A2], Key2:=[B2], Header:=xlYes
Dim t!: t = Timer
Dim rr As Range
Dim i As Long, k As Long
Dim LastRow As Long
Dim v
Application.ScreenUpdating = False '/ True
LastRow = [A65536].End(xlUp).Row
v = Range("A1:B" & LastRow).Value2
For i = LastRow To 2 Step -1
If v(i - 1, 1) = v(i, 1) Then 'A列が上下同じデータで、
If v(i - 1, 2) = v(i, 2) Then 'かつ、B列も上下同じなら、
Rows(i).Delete 'ただちに 行削除を実行
k = k + 1
End If
End If
Next
Application.ScreenUpdating = True
Debug.Print "'DEL_onDemand "; Timer - t; " ("; k; "行Delete"
End Sub
'この方法ですと、
Application.ScreenUpdating = False '/ True で画面の更新制御をすると
しないとでは、処理スピードに大きなさがあります。
'DEL_onDemand 84.08594 秒 ( 5000 行Delete---- ScreenUpdatingなし
'DEL_onDemand 19.78516 ( 5000 行Delete ----ScreenUpdating付き
'この方法しかないときは、Application.ScreenUpdating = False '/ True
による画面更新の抑止は必須です。
しかし、もともとApplication.ScreenUpdating = False '/ True の効果が
おおきいプログラムは シートにそれほど頻繁にアクセスしているという
ことです。セルへのアクセスは極力抑えたコードを書き、
Application.ScreenUpdating = False '/ True を使わなくても処理が効率
よく遂行されるようなコーディングに心がけましよう。
'Unionメソッドで 削除行を変数にまとめておき、最後に一括 行削除
Sub Test2_Union()
'範囲をソートする
Worksheets("Org").Copy After:=Sheets(Sheets.Count)
Range("A1").CurrentRegion.Sort Key1:=[A2], Key2:=[B2], Header:=xlYes
Dim t!: t = Timer
Dim rr As Range
Dim i As Long
Dim LastRow As Long
Dim v
LastRow = [A65536].End(xlUp).Row
v = Range("A1:B" & LastRow).Value2
For i = LastRow To 2 Step -1
If v(i - 1, 1) = v(i, 1) Then 'A列が上下同じデータで、
If v(i - 1, 2) = v(i, 2) Then 'かつ、B列も上下同じなら、
'削除行を変数に格納
If rr Is Nothing Then
Set rr = Rows(i)
Else
Set rr = Union(rr, Rows(i))
End If
End If
End If
Next
Debug.Print "'UnionRows "; Timer - t
If Not rr Is Nothing Then
rr.Delete
End If
End Sub
こちらの環境では、'UnionRows 0.2851563秒 でした。
|
|
kanabun
- 08/7/16(水) 11:20 -
