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

複数の列を高速で削除する方法で悩んでおります。
別々の4つのシートに71個の同じ項目が用意されています。
ユーザーの設定で欲しい項目のみ表示させたいと思っております。
以下使用しているコードの内容です。

--------------------------------------------------------------------
Sub HideRun()

Dim cnt As Integer

Dim HinagaraRan As Range
Dim CompRan As Range
Dim ProRan As Range
Dim SetRan As Range

cnt = 71
'非表示の設定を格納
Do While cnt <> 0
If HideMember(cnt) <> 0 Then
If HinagaraRan Is Nothing Then
Set HinagaraRan = TergetHinagataSheets.Columns(HideMember(cnt))
Set CompRan = TergetCompletionSheets.Columns(HideMember(cnt))
Set ProRan = TergetProvisionalSheets.Columns(HideMember(cnt))
Set SetRan = TergetSetSheets.Columns(HideMember(cnt))
Else
Set HinagaraRan = Union(HinagaraRan, TergetHinagataSheets.Columns(HideMember(cnt)))
Set CompRan = Union(CompRan, TergetCompletionSheets.Columns(HideMember(cnt)))
Set ProRan = Union(ProRan, TergetProvisionalSheets.Columns(HideMember(cnt)))
Set SetRan = Union(SetRan, TergetSetSheets.Columns(HideMember(cnt)))
End If
End If
cnt = cnt - 1
Loop

HinagaraRan.EntireColumn.Delete
CompRan.EntireColumn.Delete
ProRan.EntireColumn.Delete
SetRan.EntireColumn.Delete

End Sub

--------------------------------------------------------------------
問題なのがSetRan.EntireColumn.Deleteの実行がやたら時間がかかってしまっています。
(※TergetSetSheetsはデータが60000件入っております)
他のシートは削除に時間がかからない為、データ件数が影響しているのではないかと考えSetRan.EntireColumn.Clearを加えて列の削除前にデータの削除を行いましたが、遅くなりました；

現在の処理のスピードです。
データ数：65535件　処理速度：14.89063秒
データ数： 9409件　処理速度：14.84375秒
となっています。

この内容からもデータ件数による影響はあまり関係ないのではないかと思っています。
となると私のコードの書き方に問題があると思い質問いたしました。

何かいい方法がありましたらお力を貸してください。
宜しくお願いいたします。

No.1 ベストアンサー 回答者： 30246kiku 回答日時： 2015/04/27 11:40

速くなるかわかりませんが、作業用に１行使えるものとします

以下は、前回の質問での、行・列 の違いだけです

削除を指示する配列は Variant で、削除する所に 1 を設定しておきます。
（設定しない所の初期状態 Empty も利用）
（配列添え字＝列位置にしておく）

・対象シート１行目に１行挿入
・挿入した行に削除指示配列をそのまま代入
・１行目の 1 を特定して .EntireColumn.Delete
・作業用の行を削除して

をシート分繰り返す
Samp1 は雰囲気


Option Explicit

Public Sub Samp1()
　　Dim vA As Variant, v As Variant

　　ReDim vA(1 To 71)
　　vA(2) = 1
　　vA(5) = 1
　　vA(6) = 1
　　vA(8) = 1
　　vA(15) = 1
　　vA(16) = 1

　　For Each v In Array("Sheet1", "Sheet2", "Sheet3", "Sheet4")
　　　　With Worksheets(v)
　　　　　　.Rows(1).Insert
　　　　　　With .Rows(1)
　　　　　　　　.Cells(1).Resize(, UBound(vA)) = vA
　　　　　　　　.SpecialCells(xlCellTypeConstants, xlNumbers) _
　　　　　　　　　　.EntireColumn.Delete
　　　　　　　　.EntireRow.Delete
　　　　　　End With
　　　　End With
　　Next
End Sub


※ 列が 71 しかないのなら

>　　　　　　With .Rows(1)
>　　　　　　　　.Cells(1).Resize(, UBound(vA)) = vA
↓
　　　　　　With .Cells(1).Resize(, UBound(vA))
　　　　　　　　 .Value = vA
でも･･･
※ この記述にしておいたのは、
配列 HideMember (1 ～ 71) の内容がどうなっているのかわからなかったため


これを元に、提示あった変数等を使ってみると

Public Sub Samp2()
　　Dim vA As Variant, v As Variant
　　Dim i As Long

　　vA = Array(TergetHinagataSheets, _
　　　　　　TergetCompletionSheets, _
　　　　　　TergetProvisionalSheets, _
　　　　　　TergetSetSheets)

　　For Each v In vA
　　　　With v
　　　　　　.Rows(1).Insert
　　　　　　With .Rows(1)
　　　　　　　　For i = 1 To 71
　　　　　　　　　　If (HideMember(i) <> 0) Then
　　　　　　　　　　　　.Columns(HideMember(i)).Rows(1) = 1
　　　　　　　　　　End If
　　　　　　　　Next
　　　　　　　　.SpecialCells(xlCellTypeConstants, xlNumbers) _
　　　　　　　　　　.EntireColumn.Delete
　　　　　　　　.EntireRow.Delete
　　　　　　End With
　　　　End With
　　Next
End Sub


※ 未検証

※ 配列 HideMember の中身はどうなっているのでしょう
列位置を数値にしたもの？ 3 とか？
文字列のまま？ "B" とか？
範囲を示す？　"D:F" とか？
一応、これらのパターンどれでも動くと思います

　　ReDim vA(1 To 71)
　　vA(2) = 2
　　vA(5) = "D:F"
　　vA(6) = "J:L"
　　vA(8) = "O"
で
　　　　　　　　For i = 1 To 71
　　　　　　　　　　If (vA(i) <> 0) Then
　　　　　　　　　　　　.Columns(vA(i)).Rows(1) = 1
　　　　　　　　　　End If
　　　　　　　　Next

した時には If でエラーにならず、動きましたが･･･
内容によって良さそうな記述に変更してください。

.Columns(vA(i)).Rows(1)　で良いのか･･･とか


※ 上記処理では１行目に挿入していますが、シートの構成で
他セルを参照する計算式等が埋め込まれていたら遅くなると思います。
その時には、行位置を変更しない 最終行＋xx の所を作業用にすれば良いと思います。

※ SpecialCells を使っているので、想定量？でしっかり検証してください
前回の SpecialCells.EntireRow.Delete では、ある程度分割しないとおかしくなってたので･･･
SpecialCells.EntireColumn.Delete する時も、分割処理が必要？かも？？

蛇足になりますが、
前回質問の記述で xls 行ぎりぎりまで使われると思っていなかったので、処理の抜けがあります。
たぶん、65001 ～ 65534 内は削除されていなかったと思います。

>　　　　　　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

↓
　　Dim j As Long を宣言しておいてから

　　　　　　On Error Resume Next
　　　　　　j = iRowH Mod CLIMIT
　　　　　　If (j = 0) Then j = CLIMIT
　　　　　　For i = (iRowH - 1) \ CLIMIT To 0 Step -1
　　　　　　　　.Cells(i * CLIMIT + 1).Resize(j) _
　　　　　　　　　　.SpecialCells(xlCellTypeConstants, xlNumbers) _
　　　　　　　　　　.EntireRow.Delete
　　　　　　　　j = CLIMIT
　　　　　　Next

の方が良いかと･･･
回答は最終形ではないので、検証はしっかりと行ってください。

この回答へのお礼

30246kikuさん
度々回答ありがとうございます。
前回の回答に対するアドバイスもしていただき勉強になりました。
また今回の問題に対しての対策を行ってみたところ処理速度はあまり変化がありませんでした。
他の方法でなにかないか模索してみたいと思います。

お礼日時：2015/04/29 13:13

No.3 回答者： hallo-2007 回答日時： 2015/05/02 23:46

まだ解決しませんか。

うまくいくかは実験してみてください。
Deleteは、エクセルでも結構負担になる動作です。
関数でもかかっていたらなおさらです。

一案ですが
７１列程度であれば
必要な列をその都度、別シートに追加した方が早いかと

この回答へのお礼

hallo-2007さん

別シートに追加とは思いつかなかったです!!
試してみます!

お礼日時：2015/05/09 21:54

No.2 回答者： 30246kiku 回答日時： 2015/04/30 17:43

＃１です

ダメもとで、現状の処理を以下記述で挟んでみてどうなりますか


Application.Calculation = xlCalculationManual

～ 現状の処理

Application.Calculation = xlCalculationAutomatic


実際にはシートはその４つだけではなくて、
他シートから参照されていたり････とかあったりして？
その場合には速くなるかも？

また、Change イベント等処理を記述していたら、
イベントを抑止してからやってみるとか

この回答へのお礼

30246kikuさん

返信遅くなり申し訳ありません。
特に参照させていないのであまり変化が得れませんでした；
今回はデーター量が大きい場合は処理前に時間がかかる処理だとアナウンスを置くこととプログレスバーの設置で対応してみます；

エクセルのバージョンに左右されないためになるべく関数などは使用しない方向で作成したいと思っていました。
30246kikuさんのアドバイスは望んだ結果ではなかったですが手法としてとても勉強になりました。
なのでベストアンサーとして選ばさせていただきたいと思います。
ありがとうございました。

お礼日時：2015/05/09 22:04