|    | 
     ▼勉強中さっち さん: 
>>毎回削除するのではなく、最後にまとめて削除するように改良するだけでも 
>>格段の進歩ですよ (^^ 
> 
>そうですね。 
>まとめて削除するなら、削除行をまとめる入れ物作成して、最終的に 
>入れ物.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秒 でした。 
 | 
     
    
   |