t-hom’s diary

主にVBAネタを扱っているブログ…とも言えなくなってきたこの頃。

VBA クラスモジュールをゴミ箱代わりに使って複数列を一気に削除する方法

先日Excel方眼紙で作成された表を1データ1列の綺麗な表に変換するために、空白行を削除するというシチュエーションが発生した。

以下は今回のマクロ紹介のために作成したダミー。全国の郵便番号データから無作為に100件選んだものである。
f:id:t-hom:20161105205612p:plain

上記の表では列が結合されているが、これを以下のように1データ1列の綺麗なデータにしたい。
f:id:t-hom:20161105211823p:plain

VBAで列の削除処理は比較的重たい処理である。1行ずつ削除するのは時間がかかるうえ、消したそばから次のデータが左にズレ込むため処理が面倒になる。

そこで消したい列を一旦リストアップしておいて、一気に削除するという方法をとる。
これなら1行ずつ消すのに比べてデータのズレを考慮する必要もないし、重たい削除処理が1度で済むので全体のスピードも上がる。

これ、Windowsとかのゴミ箱の動作に似ている。
消すデータを一旦そこに放り込んでおいて、あとで空にするのだ。

ということで、まずはクラスモジュールを挿入しプロパティからオブジェクト名を「列ゴミ箱」と名づける。
f:id:t-hom:20161105213000p:plain

そして次のコードを挿入。

Public シート As Worksheet
Private ゴミ箱 As Range

Sub 列を捨てる(列番号)
    Dim 捨てる列 As Range
    Set 捨てる列 = シート.Cells(1, 列番号).EntireColumn
    
    If ゴミ箱 Is Nothing Then
        Set ゴミ箱 = 捨てる列
    Else
        Set ゴミ箱 = Union(ゴミ箱, 捨てる列)
    End If
End Sub

Sub ゴミ箱を空にする()
    ゴミ箱.Delete
    Set ゴミ箱 = Nothing
End Sub

そして、作成した列ゴミ箱を使って標準モジュールに書くコードは以下のとおり。

Sub 空列を削除()
    Dim R As 列ゴミ箱: Set R = New 列ゴミ箱
    Set R.シート = Sheets(1)
    Dim x As Range
    For Each x In Sheets(1).Range("A1:Z1")
        If x.Value = "" Then
            R.列を捨てる x.Column
        End If
    Next
    R.ゴミ箱を空にする
End Sub

実行するとこのように不要列が削除されるので、あとは列幅を手で整えておしまい。
f:id:t-hom:20161105215515p:plain

メインコードから説明すると、まずは変数Rを列ゴミ箱型として宣言し、「シート」プロパティにSheets(1)をセットしている。For Eachでヘッダ行を1セルずつループさせ、空だったら空行とみなし、列ゴミ箱変数Rの「列を捨てる」メソッドに列の番号を渡す。

するとクラスモジュールでは渡された番号の列をRange型の変数「ゴミ箱」にセットする。
すでにゴミ箱にデータがあれば、Union関数で結合する。

メインコードのループを抜けたら最後にゴミ箱を空にするメソッドを呼び、実際に行が削除される。

と、ここまで書いておいてなんだけど、これ、もっと汎用的に作れることに気付いた。
わざわざ列番号を受け取って保持しているシートの列に変換しなくたって、捨てるメソッドが直接Rangeを受け取ればいいんだ。そうすれば対象を列に限定する必要もなくなる。

ということで、クラスモジュールの名前を「Rangeゴミ箱」と変更。
ちょっと和英混じりでダサいので、真似する方はもっとかっこいい名前をつけよう。
Rangeゴミ箱のコードは以下のとおり。

Private ゴミ箱 As Range
Sub 捨てる(捨てるRange As Range)
    If ゴミ箱 Is Nothing Then
        Set ゴミ箱 = 捨てるRange
    Else
        Set ゴミ箱 = Union(ゴミ箱, 捨てるRange)
    End If
End Sub
Sub ゴミ箱を空にする()
    ゴミ箱.Delete
    Set ゴミ箱 = Nothing
End Sub

メインのコードは以下のように変更

Sub 空行を削除2()
    Dim R As Rangeゴミ箱: Set R = New Rangeゴミ箱
    Dim x As Range
    For Each x In Sheets(1).Range("A1:Z1")
        If x = "" Then
             R.捨てる x.EntireColumn
        End If
    Next
    R.ゴミ箱を空にする
End Sub

今度のRangeゴミ箱は直接Rangeを受け取るので、あらかじめシートをセットしておく必要もない。
ただし、シートをセットしなくて良いからといって複数シートをまぜこぜでゴミ箱に放り込むことはできないと思う。やってないのでわからないけど、Union関数でコケる。たぶん。

まあ、複数シートのRangeを一気に削除するようなオブジェクトも作ろうと思えば作れるので、興味があればトライしてみると良いかもしれない。内部のゴミ箱を配列にして、渡されたRangeのParentで何番目のゴミ箱に入れるかコントロールすればたぶん作れる。

また、列と行を一気に削除するのもうまくいかない。Unionまではできても、削除で範囲重複となってエラーになるはずだ。これもクラスモジュールの内部で列用と行用のゴミ箱をごにょごにょすればたぶん一気に削除する機能が作れる。

今のところ必要性を感じないためどちらも作らないけれど。

当ブログは、amazon.co.jpを宣伝しリンクすることによってサイトが紹介料を獲得できる手段を提供することを目的に設定されたアフィリエイト宣伝プログラムである、 Amazonアソシエイト・プログラムの参加者です。