エクセルVBA Unionはなぜ遅い？

他所サイトのQ&Aです。行削除の下記３つの方法について
①Unionで溜めておき一気に削除。変数でなくSelectで溜める
②Unionで溜めておき一気に削除。変数で溜める
③最終行から１行ずつ削除

300行削除　　いずれも0.2秒程度
3000行削除　①②140秒　③2秒
Unionを使う場合、処理行数が多くなると急激に遅くなります。なぜ？と言っても仕様なのだからしょうがない？③と同等または遅いくらいなのだから、Union使う意味ないように思えて来ました。これまでの自分の認識ではUnion一気削除の方が速いので、少々困惑気味です。

Sub ①()
t = Timer
Application.ScreenUpdating = False
Max = 10000
For i = 3 To Max
If i Mod 2 <> 0 Then
If i = 3 Then
Rows(i).Select
Else
Union(Selection, Rows(i)).Select
End If
End If
Next i
Selection.Delete shift:=xlUp
Application.ScreenUpdating = True
Cells(1, 1).Value = Timer - t
End Sub

Sub ②()
Dim rng As Range, i As Long
t = Timer
Max = 10000
Set rng = Cells(3, 1)
For i = 5 To Max Step 2
Set rng = Union(rng, Cells(i, 1))
Next i
rng.EntireRow.Delete
Cells(1, 2) = Timer - t
End Sub

Sub ③()
Dim i As Long
Dim Max As Long
t = Timer
Max = 10000
For i = Max To 3 Step -2
Rows(i).Delete
Next i
Cells(1, 3) = Timer - t
End Sub

質問者からの補足コメント

• 問題の詳細が判明しました。
  >For i = 5 To Max Step 2
  For i = 5 To Max だと短時間です。つまりStep 2　の場合に遅くなります。処理回数は半分になる筈なのに。Step 3にすると30秒、、、

  No.1の回答に寄せられた補足コメントです。 補足日時：2016/07/28 20:44

No.1 回答者： trajaa 回答日時： 2016/07/27 21:53

メモリ内で処理が完結するでのあれば、方式の違いによる処理時間の差は小さい

が一旦メモリ内で処理できるサイズを超えると、メモリよりも二桁(百倍)も遅い外部記憶を使わざるを得ない
つまり処理そのモノではなく、そこで使用する記憶装置の速度に引きずられる

この回答へのお礼

ありがとうございます。
Unionの許容値は結構小さいようですね。

お礼日時：2016/07/28 19:13

No.2 ベストアンサー 回答者： WindFaller 回答日時： 2016/07/29 00:11

こんばんは。

あまり細かい所までは検討されていませんが、確かに、メモリの許容量というものが存在するのかもしれません。しかし、これほど細切れですと、Union でその都度取り込んでいくことに、オーバーヘッドが掛かって遅延化してくるのではないでしょうか？

以下は、Application.ScreenUpdating = False　には、影響されませんが、なぜか、Select を使ったほうが速いようです。
メモリ自体の問題なら、以下の場合も問題が発生するように思うのです。

タイムは、
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
を使いました。

{④_A}: 3192
{④_B}: 2426

Sub ④_A()
　With　Range("A1").CurrentRegion
　　With .Columns(.Columns.Count + 1)
　　　 .FormulaLocal = "=IF(MOD(ROW(),2)=1,"""",1)"
　　　 .Value = .Value
　　　 .SpecialCells(xlCellTypeConstants, xlNumbers).EntireRow.Delete
　　End With
　End With
　Range("A1").Select
End Sub

Sub ④_B()
　With Range("A1").CurrentRegion
　　With .Columns(.Columns.Count + 1)
　　　 .FormulaLocal = "=IF(MOD(ROW(),2)=1,"""",1)"
　　　 .Value = .Value
　　　 .SpecialCells(xlCellTypeConstants, xlNumbers).EntireRow.Select
　　End With
　End With
　 Selection.Delete
　Range("A1").Select
End Sub
'//

> Step 2　の場合に遅くなります。
この場合は、対象セルの移動自体に負荷がかかるのではないかと思うのです。

この回答へのお礼

いつもありがとうございます。
1行おきに選択するため、unionのオーバーヘッドにより遅延するが理由のようですね。オーバーヘッドは知りませんでした。勉強になりました。

お礼日時：2016/07/29 19:10

No.3 回答者： 30246kiku 回答日時： 2016/07/29 10:36

Union の処理を推測すればわかると思いますよ

以下を記述して、実行してみると

Public Sub Samp1()
　　Dim rng As Range

　　Set rng = Range("B2")
　　Debug.Print rng.Address
　　Set rng = Union(rng, Range("B3"))
　　Debug.Print rng.Address
　　Set rng = Union(rng, Range("B4"))
　　Debug.Print rng.Address
　　Set rng = Union(rng, Range("C2"))
　　Debug.Print rng.Address
　　Set rng = Union(rng, Range("C3"))
　　Debug.Print rng.Address
　　Set rng = Union(rng, Range("C4"))
　　Debug.Print rng.Address
End Sub

表示されるのが以下

$B$2
$B$2:$B$3
$B$2:$B$4
$B$2:$B$4,$C$2
$B$2:$B$4,$C$2:$C$3
$B$2:$C$4


隣接する塊にしようという動きをするみたい？？
個数が多くなれば、この処理に時間がかかるようになり･･･

という解釈では？


一気に削除するのなら、
作業列（行）を１つ使って、残す行には行番号、消す行は空白･･･
１行目が項目行なら、空白設定
項目行がなければ、１行目に行挿入･･･
全体を対象に、作業列で「重複の削除」
空白部分は先頭側の１個以外は重複で消えるので･･･
行挿入していたらその行消して、作業列綺麗にして･･･
これが速いと思います

SpecialCells という話もあるかもしれませんが、
これが扱える領域個数には上限（8192）があって、
大量のデータの時には使えない
SpecialCells を如何しても使いたいのであれば、
作業列で消したい行は空白、残したいものは行番号
これでソートして････
空白は後ろ１か所にまとまるので　SpecialCells　での領域数は１つ･･･

この回答へのお礼

ありがとうございます。
Unionされたセル範囲の中身確認は思い付きませんでした。対策は編集列を設けて重複削除、specialcellsと色々あるようですね。

お礼日時：2016/07/29 19:24

No.4 回答者： WindFaller 回答日時： 2016/07/30 10:03

こんにちは。

　A　　　 B　　　 C　　　　D　　E
59444　43249　40485　52547　　　1　←連番
12万行で同じく試してみました。
さすがに、Application.ScreenUpDating は加えました。

Sub ④_B()
　With Range("A1").CurrentRegion
　　With .Columns(.Columns.Count + 1)
　　　 .FormulaLocal = "=IF(MOD(ROW(),2)=1,"""",1)"
　　　 .Value = .Value
　　　 .SpecialCells(xlCellTypeConstants, xlNumbers).EntireRow.Select
　　End With
　End With
　 Application.ScreenUpdating = False
　 Selection.Delete
　 Application.ScreenUpdating = True
　Range("A1").Select
End Sub
'//

120000 → 60000
④_B: 384135 (0:06:24)

SepcialCells については、実際、こちらでも試してみました。
Excel 2013 で、SpecialCells は、最後まで通りました。

http://www.excelguru.ca/blog/2009/07/23/excel-20 …
Excel 2010 Finally Fixes SpecialCells 8192 Limit

SpecialCells についての問題は、Excel 2007までで、Excel 2010では直ったと上記では書かれています。Excel 2007の問題については、他でも、Excel 2007専用に、特別あつらえしなければならないようです。

決して、上位バージョンがよいというわけではありませんが、Version ごとに問題が隠れていることがありますから、本来は、Version を言わないといけないこともあるのかもしれません。よくある話なのですが・・・。

この回答へのお礼

再度ありがとうございます。
制限はもうないようですね、バージョンは2010だった筈です。

お礼日時：2016/07/31 23:01

No.5 回答者： 30246kiku 回答日時： 2016/07/31 09:08

＃３です

今回のご質問は、消すことではなく･･･
> Unionはなぜ遅い
ですよね

消す方法の具体例を記述した方が良いのでしょうか？
ということで

> 他所サイトのQ&Aです。行削除の下記３つの方法について

他所サイトのQ&A は、以下だったでしょうか？

Vbaにて3行目以上の奇数行を削除するこーどをか
http://detail.chiebukuro.yahoo.co.jp/qa/question …

私は３つの方法以外で回答してました
＃３で記述した 重複の削除 を使った方法を･･･
実際にやって･･･確認しやすいようにデータ作成も付けていたのに･･･
質問者さんには不評だったようです

こちらにも載せておきます
なお、確認用データ作成部分は 12万件 用に変えておきました

わかりにくそうなところを解説しておくと、
変数 i は、UsedRange は必ず A1 ～ 得られるものではないので
A1 ～ の範囲を対象にするための調整用
※ 今回は行方向だけを考えれば良いので、列方向は無視
変数 j は、作業用列

３行目からということで、１行目の空白だけが残れば･･･

※ バージョンによって 重複の削除 が使えない･･･なら、
SepcialCells　の上限はある？？･･･
･･･なら、他の方法を考える？　並び替えして領域数を減らす？

ちなみに、2007 では ④_B 実行で全部消えた･･･
なので、私の環境では比較はできませんが、以下 Samp1 は
１２万行では、2 秒以下（列数によって若干変動）
２万行では 0.3 秒付近（列数によって若干変動）


Public Sub Samp1()
　　Dim i As Long, j As Long
　　Const CF As String = "=IF(MOD(ROW(),2)=0,ROW(),"""")"

　　Application.ScreenUpdating = False
　　With ActiveSheet.UsedRange
　　　　i = 1 - .Cells(1).Row
　　　　j = .Columns.Count + 1
　　　　With .Offset(i).Resize(.Rows.Count - i, j)
　　　　　　With .Columns(j)
　　　　　　　　.Formula = CF
　　　　　　　　.Value = .Value
　　　　　　End With
　　　　　　.RemoveDuplicates j, xlNo
　　　　　　.Columns(j).ClearContents
　　　　End With
　　End With
　　Application.ScreenUpdating = True
End Sub



' 確認用データ作成

Public Sub testData2()
　　Dim r As Range
　　Dim i As Long, j As Long
　　Const CRH As Long = 120000

　　Randomize
　　i = Int(4 * Rnd())
　　j = Int(10 * Rnd()) + 1

　　Application.ScreenUpdating = False
　　Cells.Delete
　　For Each r In Range("A1").Offset(i).Resize(2, j)
　　　　r.Value = r.Address(False, False)
　　Next
　　With Range("A1").Offset(i).CurrentRegion
　　　　.AutoFill .Resize(CRH)
　　End With
　　Columns.AutoFit
　　Application.ScreenUpdating = True
End Sub


※ Application.ScreenUpdating 使うのなら、上記の様に
セルに何か操作する部分も False ～ True で挟んだ方が良いと思います

No.6 回答者： 30246kiku 回答日時： 2016/07/31 18:23

＃５です

せっかくなので、
> SpecialCells を如何しても使いたいのであれば、
> 作業列で消したい行は空白、残したいものは行番号
> これでソートして････
> 空白は後ろ１か所にまとまるので　SpecialCells　での領域数は１つ･･･

★ 部分が Samp1 からの変更点です

作業列内、消す行を空白にして、１行目は消しちゃいけないので 1 を設定
その後、全体を対象に作業列で昇順ソートして、
１個の領域になった空白部分を SpecialCells にて･･･
念のため、空白がない時用に On Error Resume Next

※ SpecialCells も対象が連続しているので速い･･･
Samp1 とあまり変わらない処理時間かと･･･

今回の様に、対象が飛びとびの状態で SpecialCells します？
実際に体感してみてください･･･


Public Sub Samp2()
　　Dim i As Long, j As Long
　　Const CF As String = "=IF(MOD(ROW(),2)=0,ROW(),"""")"

　　Application.ScreenUpdating = False
　　With ActiveSheet.UsedRange
　　　　Debug.Print .Cells.Address
　　　　i = 1 - .Cells(1).Row
　　　　j = .Columns.Count + 1
　　　　With .Offset(i).Resize(.Rows.Count - i, j)
　　　　　　With .Columns(j)
　　　　　　　　.Formula = CF
　　　　　　　　.Value = .Value
　　　　　　　　.Cells(1) = 1 ' ★
　　　　　　End With
　　　　　　.Sort .Cells(j), xlAscending, Header:=xlNo ' ★
　　　　　　With .Columns(j) ' ★
　　　　　　　　On Error Resume Next ' ★
　　　　　　　　.SpecialCells(xlCellTypeBlanks).EntireRow.Delete ' ★
　　　　　　　　On Error GoTo 0 ' ★
　　　　　　　　.ClearContents
　　　　　　End With
　　　　End With
　　End With
　　Application.ScreenUpdating = True
End Sub

この回答へのお礼

再度ありがとうございます。
他回答の参照URLでソート使って対策してたとありましたが、これだった様ですね。なるほど。

お礼日時：2016/07/31 23:16