今日を乗り切るExcel研究所

Excel に働かされていませんか

【VBA】セルの値によって行を削除したい【100本ノック】

エクセルの神髄様の Twitter 企画「VBA100本ノック」の問題への解答記事です。 今回はその10本目になります。Sort を使います。

お題:VBA100本ノック 10本目:行の削除

方針

セルの値を見て、条件にマッチするデータ行を削除するという課題です。

普通にセルを走査するループを書けば難しいことはありませんが、 行の削除は比較的重い処理なので、データ量が多いとロジックを工夫する必要があるかもしれません。

できれば Excel に処理させたいですね。

解答ページやこれまでの回答ツイートを見ると AutoFilter を使った解答が多いようです。 AutoFilter で条件にマッチした行を絞り込んでもらえれば、あとは行ごと一括で削除すればいいというものです。

いいアイデアです。 Excel にはいろいろ絞り込みの機能があるので、それらでも応用できるかもしれません。

でもこの記事では、あえてそれらとはちょっと違った発想で考えてみたいと思います。

それはソートを利用する方法です。

普段オートフィルタを使っている人は気付いていると思いますが、Excel で「並べ替え」をすると、 空セルの行は昇順・降順にかかわらず最後尾に移動しますね。 これはデータベースで言えば NULLS LAST に相当する動きと言えます。

これを利用してみます。

削除したい行を空行にしてソート(並べ替え)で後ろにまとめてやれば、事実上の行削除になるはずです。

サンプルデータを見ると、都合よく「商品コード」列で昇順にソートされているのでこれをキーにできます。

ところでドキュメントを調べると Excel VBA のソートには「Range の Sort メソッド」と「Worksheet が持つ Sort オブジェクト」の2つが見つかります。

これらがどう違ってどう使い分けたらいいのか、ドキュメントからは分りませんでしたが、 とりあえず簡単そうな Range の Sort メソッドの方を採用してみることにします。

解答:Sort を使ってみる

Option Explicit

Sub VBA100_010()
    Const 商品コード = 1
    Const 受注数 = 3
    
    Application.ScreenUpdating = False
    
    Dim table As Range
    Set table = ActiveSheet.Range("A1").CurrentRegion ' シートは任意
    
    Dim blanks As Range
    On Error Resume Next
    Set blanks = table.Columns(受注数).SpecialCells(xlCellTypeBlanks)
    On Error GoTo 0
    If blanks Is Nothing Then Exit Sub
    
    Dim c As Range
    For Each c In blanks
        If strContainsAny(c.Offset(, 1).Value, "削除", "不要") Then
            ' データ行を空行にする
            c.EntireRow.ClearContents
        End If
    Next
    
    ' 空行を最後尾へ
    table.Sort table.Columns(商品コード), xlAscending, Header:=xlYes

    Application.ScreenUpdating = True
End Sub

Private Function strContainsAny(txt As String, ParamArray keywords() As Variant) As Boolean
    Debug.Assert UBound(keywords) >= 0
    Dim p As Integer
    Dim k As Variant
    For Each k In keywords
        p = InStr(txt, k)
        If (Not IsNull(p)) And (p > 0) Then
            strContainsAny = True
            Exit Function
        End If
    Next
    strContainsAny = False
End Function

データ範囲がオートフィルタなどによって絞り込まれている状態では、なぜかうまくいかないので使用時に注意が必要です。

 



 

考察

単純に行数を増やしてみたかぎり、Sort の方が行削除よりも速くなるようです。 削除対象行の割合や散らばり具合によるのかもしれませんが、そこまではちゃんと検証できていません。

ひとつ要件を満たしていないかもしれない件に「行全体を削除」があります。

ソートはデータ範囲の中だけで行われているので、その外のセルはクリアされるものの位置は変わりません。 もし外のセルに値が入っていれば結果的に、データ範囲の中と外で行のズレが生じます。 これを防ぎたいなら、ソート対象をデータ範囲だけでなく、シート全体に広げます。

さて、今回の課題のデータではたまたま「商品コード」列でソートされていたのでそのままソートキーにできました。

もし、ソートできる列がなくて、かつ元の行順序を崩したくないという場合はどうしたらいいでしょうか。

その場合、ソートする補助列を一時的に追加することになります。 そのときセルに入力する値はすべて同じでかまいません。 Sort は同じ値間の順序を変更しないからです。 (Sort のアルゴリズムが「安定ソート」であるという確証はドキュメントを探しても得られないのですが、 挙動からはそうであると推測できます)

   ・・・

    Dim sortKey
    sortKey = table.Columns.Count + 1
    Set table = table.Resize(, sortKey) ' 右の列は空列のはず
    table.Columns(sortKey).Value = 0 ' 同じ値を詰める。数値の方が速い

   ・・・

    ' 安定ソート
    table.Sort table.Columns(sortKey), xlAscending, Header:=xlYes
    table.Columns(sortKey).ClearContents

【注意】 本マクロによって消されたデータは「元に戻す(Undo)」することができません。本記事のマクロを実業務データで使用する際は、あらかじめバックアップを取るなど細心の注意を払ってください。 また本マクロの不具合や誤操作によって生じたいかなる損害や損失についても本ブロクは責任を負いかねますのであらかじめご了承ください。

関連記事

なし