[[20181212111702]]　『見出し２行以外が空の列をまとめて削除したい』（じす）　ページの最後に飛ぶ

『見出し２行以外が空の列をまとめて削除したい』（じす）

VBAで、見出し２行以外が、空の列を見出しごと一括削除したいです。

 （今回作業するエクセルデータの見出しは、 
 　１行目は英語表記、２行目に日本語表記と、２行ある状態です。）

例えば…

　　　apple　 orange 　berry 　 banana　 melon
　　　りんご　みかん　いちご　バナナ　メロン

川村　　１　　　１　　　　　１

青山　　　　　　１　　　　　１　　　　　　　　　１

吉野　　１　　　　　　　　　　　　　　　　　　　１

 　 
岩谷　　　　　１

上記のようにbananaバナナにはデータがない場合、

 見出し１行目のbananaと２行目のバナナごと、列を削除したいです。

　　　apple 　 orange 　berry 　 melon
　　　りんご　みかん　いちご　メロン

川村　　１　　　１　　　　　１

青山　　　　　　１　　　　　１　　　　１

吉野　　１　　　　　　　　　　　　　　１

 　 
岩谷　　　　　１

列や行の数が少なければ、目視で削除していくのですが、
数百列・数百行あるため、ＶＢＡで作業したいです。
お手数ですが、ご教示の程、よろしくお願いいたします。

Sub 見出しの二行以外が空の列を見出し二行ごと削除する()

    With ActiveWorkbook.ActiveSheet

        Dim idx As Long
        Dim i As Long '
        i = 0

        For idx = .Cells(1, 16384).End(xlToLeft).Column To 1 Step -1
            If Application.WorksheetFunction.CountA(.Columns(idx)) = 2 Then
                .Columns(idx).Delete
                i = i + 1
            End If
        Next idx
        MsgBox (i & "列削除")
    End With
End Sub

＜使用 Excel：Excel2010、使用 OS：Windows7 ＞

 タイトルが2行とも入力されているなら、そのコードでいいと思うんですけど、
 何かマズい事態が生じたんですか？

（半平太） 2018/12/12(水) 11:39

半平太さんもおっしゃっているように現状でもよいとおもいますが、やってみたら遅かったので改善方法がないかということですかね？
たしかに、数百列を１列ずつ判定して～削除して～を繰り返すと遅くなるかもですから、該当の列を探しておいて、最後にまとめて削除したらどうでしょう？

    Sub さんぷる()
        Dim i As Long, 削除セル As Range

        Stop '←ブレークポイントの代わり（以下、ステップ実行して研究のこと）

        With Range("A1").CurrentRegion
            For i = 1 To .Columns.Count
                If Application.WorksheetFunction.CountA(.Columns(i)) = 2 Then
                    If 削除セル Is Nothing Then
                        Set 削除セル = .Columns(i)
                    Else
                        Set 削除セル = Union(削除セル, .Columns(i))
                    End If
                End If
            Next i

            If 削除セル Is Nothing Then Exit Sub

            If MsgBox("データが無い列を削除してよろしいですか？", vbYesNo) = vbYes Then
                削除セル.Delete Shift:=xlShiftToLeft
            End If
        End With

    End Sub

まぁ、元のコードでも画面更新を抑止すれば解決するような気もしますが・・・
http://officetanaka.net/excel/vba/speed/s1.htm

（もこな２） 2018/12/12(水) 12:38

半平太様
コードをご確認くださり、ありがとうございます。
コード自体は合っているのですね…。
削除されるはずが削除されない列があり、掲示板を利用させていただきました。
私が朝から何度もコードを書き直しては試しを繰り返していたうえ、
データも他の人の手により色々修正されたりしていたので、
ブック自体に何か問題が生じてしまったのかもしれません。確認します。

もこな２様
コードのご確認と改善案のご提案をありがとうございます。
量が多く、処理速度も気になっていたので、
「該当の列を探しておいて、最後にまとめて削除」する方法、
画面更新の抑止についても、検討してみます。

この度は、お手を煩わしてしまい、申し訳ございませんでした。
お二方にコードを見ていただき、現状でよいと解り、安心しました。
コード以外の別の箇所に問題がないか、見直します。
誠にありがとうございました。
（じす） 2018/12/12(水) 13:06

コメント返信：

[ 一覧(最新更新順) ]

[[20181212111702]] 『見出し２行以外が空の列をまとめて削除したい』（じす） ページの最後に飛ぶ

[[20181212111702]]　『見出し２行以外が空の列をまとめて削除したい』（じす）　ページの最後に飛ぶ