Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


25094 / 76732 ←次へ | 前へ→

【56982】Re:重複行の削除
発言  kanabun  - 08/7/16(水) 11:20 -

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

0 hits

【56961】重複行の削除 勉強中さっち 08/7/15(火) 11:05 質問
【56962】Re:重複行の削除 kanabun 08/7/15(火) 11:30 発言
【56964】Re:重複行の削除 勉強中さっち 08/7/15(火) 11:52 お礼
【56976】Re:重複行の削除 kanabun 08/7/15(火) 23:51 発言
【56981】Re:重複行の削除 勉強中さっち 08/7/16(水) 9:41 質問
【56982】Re:重複行の削除 kanabun 08/7/16(水) 11:20 発言
【56983】Re:重複行の削除 勉強中さっち 08/7/16(水) 11:53 お礼
【56963】Re:重複行の削除 こぎつね 08/7/15(火) 11:30 発言
【56965】Re:重複行の削除 勉強中さっち 08/7/15(火) 11:53 お礼

25094 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free