複数「列」を削除高速化
うさこちゃん
条件に合う列を高速に削除したい場合にデータ量が大量にあると非常に削除が(かなり)遅い場合があります。
その場合は「Range」に削除データを貯めておいて一括して削除すると高速化できます。
①元データ
うさこちゃん
2行目に0のデータがある列を削除する。
ヘッダ | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 |
条件 | 2 | 1 | 0 | 1 | 5 | 0 | 0 | 5 | 0 | 1 | 0 |
データ | データ | データ | データ | データ | データ | データ | データ | データ | データ | データ | データ |
②処理後データ
うさこちゃん
2行目の0のデータを列削除した結果。
ヘッダ | 1 | 2 | 4 | 5 | 8 | 10 |
条件 | 2 | 1 | 1 | 5 | 5 | 1 |
データ | データ | データ | データ | データ | データ | データ |
処理速度の違い
うさこちゃん
今回は以下のデータ件数で約10倍の速度差になりました。
列データ500件
行データ100件
削除対象100件
サンプル① | 0.5273 |
サンプル② | 0.0625 |
サンプル①
Dim ObjThisSh As Object
Dim LngColMax As Long
Set ObjThisSh = ThisWorkbook.Sheets("Sheet1")
With ObjThisSh
LngColMax = .Cells(2, .Columns.Count).End(xlToLeft).Column
For LngIndex = 2 To LngColMax
If .Cells(2, LngIndex).Value = 0 Then
'列を削除
.Columns(LngIndex).Delete
End If
Next LngIndex
End With
サンプル② 高速化
Dim ObjThisSh As Object
Dim LngColMax As Long
Dim LngIndex As Long
Dim RngDelete As Range
Set ObjThisSh = ThisWorkbook.Sheets("Sheet1")
With ObjThisSh
LngColMax = .Cells(2, .Columns.Count).End(xlToLeft).Column
For LngIndex = 2 To LngColMax
If .Cells(2, LngIndex).Value = 0 Then
If RngDelete Is Nothing Then
Set RngDelete = .Cells(2, LngIndex)
Else
Set RngDelete = Union(RngDelete, .Cells(2, LngIndex))
End If
End If
Next LngIndex
If Not RngDelete Is Nothing Then
'RngDelete.EntireColumn.Select 'テスト用 削除予定列を表示させる
'列を一括削除
RngDelete.EntireColumn.Delete
End If
End With