VBA　複数の行を高速で削除する方法

Question

以前、質問で複数の行をRangeに格納し一括で削除する方法を教えていただきました。
実践したコードが以下の通りです。
>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
            'Unionで指定の行を複数格納
            For i = TergetSetSheets.Range("Y" & Rows.Count).End(xlUp).Row To 7 Step -7
                If SetRan Is Nothing Then
                    Set SetRan = TergetSetSheets.Rows(i - p)
                Else
                    Set SetRan = Union(SetRan, TergetSetSheets.Rows(i - p))
                End If
            Next
>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
500行くらいなら0.03秒くらいで処理できていたのですが、
4700行で6.8秒、9400行で52秒になりました。
※描写は停止にしています。
これ以上早く処理を行うことはできるのでしょうか？
なるべくなら行の削除を行いたいと思っています。
なぜなら表の集計をこの後に行うのにあらかじめ不要な行を先に削除しておくことにより
処理速度が上がるのではないかと思っているからです。

いい方法がありましたら知恵を貸してください。
どうかよろしくお願いいたします。

High_Score · Accepted Answer

まず現行マクロの改良としては、「オブジェクトに触る回数を少なくする」
TergetSetSheetsこれはワークシートだと思いますが、ループ内で9000行処理するなら9000回同じシート名を指定することになり、低速化の原因になります。下記のようにすると指定が省略されて速く、しかも見た目スッキリで可読性が上がります。
With TergetSetSheets
For i = .Range("Y" & Rows.Count).End(xlUp).Row To 7 Step -7
If SetRan Is Nothing Then
Set SetRan = .Rows(i - p)
Else
Set SetRan = Union(SetRan, .Rows(i - p))
End If
Next
End With

SetRanはセルではなく行のようですね。遅くなりませんか？１セルだけであっても、一括削除する際にEntireRowとすれば行になりますよ。この比較は私もしたことがないので、確信持っては言えませんが。

次に、削除せず残す方に規則性があるなら、Autofilterを使う方法があります。マクロでなく通常の手動操作でもフィルタがありますが、あれです。あれで削除する行「以外」が表示されるようにして、全選択→コピー→別シートにペースト　これでも速いです。これを考えると、手動でもいいんじゃないの？とか藪蛇な思いがあります（笑）

Union の後で一括deleteもAutofilterもそうですが、エクセルでは一気に選択、一気に処理するのが速いです。乱暴に言うと一行ステートメントで「一括処理」するのが速いのです。その意味ではFor Nextループは一回ずつ順番に9000回処理するため、低速化の一因になります。しかし今回の場合、やらない訳には行きませんので残してます。

老婆心ながら、エクセルVBAの質問なら、カテゴリはVisual Basicまたはエクセルが良いです。

30246kiku · Answer

> 例：
> 　　Ａ　　Ｂ
> 1　太郎　住所
> 2　　　　電話
> 3　　　　メールアドレス
> 4　　　　誕生日
> 5　　　　年齢
> 6　　　　性別
> 7　　　　既婚
> 8　花子　住所
> 以下続く

この７行が繰り返されていて、
例えば、年齢、既婚　部分の行を一気に消したい･･･
という事で良かったでしょうか

作業列として、今使っている最終列＋２の所の列を使います。
その作業列に
=IF(INDEX({0,0,0,0,1,0,1},MOD(ROW()-1,7)+1)>0,1,"")
という計算式を埋め込んで、削除する行を特定します。
{0,0,0,0,1,0,1}　このパターンは、
左から、住所、電話･･･に対応していて、削除したい所を > 0 で設定します。
{0,0,0,0,1,0,1}
↓誕生日も削除対象にするのなら、左から４つ目の 0 を変更
{0,0,0,1,1,0,1}

以下の Samp1 でどうなりますか？


Option Explicit

Public Sub Samp1()
　　Dim iRowH As Long, iCol As Long
　　Dim i As Long
　　Const CLIMIT As Long = 5000

　　With ActiveSheet
　　　　With .UsedRange
　　　　　　With .Cells(.Rows.Count, .Columns.Count)
　　　　　　　　iCol = .Column + 2
　　　　　　　　iRowH = .Row
　　　　　　End With
　　　　End With
　　　　With .Cells(1, iCol).Resize(iRowH)
　　　　　　.Formula = _
　　　　　　　　"=IF(INDEX({0,0,0,0,1,0,1},MOD(ROW()-1,7)+1)>0,1,"""")"
　　　　　　.Value = .Value
　　　　　　On Error Resume Next
　　　　　　For i = (iRowH - 1) \ CLIMIT To 0 Step -1
　　　　　　　　.Cells(i * CLIMIT + 1).Resize(CLIMIT) _
　　　　　　　　　　.SpecialCells(xlCellTypeConstants, xlNumbers) _
　　　　　　　　　　.EntireRow.Delete
　　　　　　Next
　　　　　　.ClearContents
　　　　End With
　　End With
End Sub


※ 速くならなかったらごめんなさい

※ ScreenUpdating　等は必要に応じて追加してください


なお、確認用データは以下で作ってました

Public Sub testData()
　　Dim r As Range

　　For Each r In Range("A1:Z30000")
　　　　r = r.Address(False, False)
　　Next
　　Columns.AutoFit
End Sub

VBA 複数の行を高速で削除する方法

まず現行マクロの改良としては、「オブジェクトに触る回数を少なくする」

> 例：

似たような質問が見つかりました

このQ&Aを見た人はこんなQ&Aも見ています

関連するカテゴリからQ&Aを探す

このQ&Aを見た人がよく見るQ&A

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング

VBA　複数の行を高速で削除する方法