[[20120417140010]]　『1行目(フィールド名)以外が空白の列を自動削除』（DAR）　ページの最後に飛ぶ

『1行目(フィールド名)以外が空白の列を自動削除』（DAR）

お世話になります。
価のない列を削除するマクロは過去ログより見つけたのですが、
下記↓

 Sub test1()
    Dim UsedCell As Range
    Dim Max_column, columnCount As Integer
    '使用しているセルの範囲を取得します
    Set UsedCell = ActiveSheet.UsedRange
    '最大の行番号を取得します
    Max_column = UsedCell.Cells(UsedCell.Count).Column
    For columnCount = Max_column To 1 Step -1
        'Worksheet関数のCountAを使ってデータの個数をカウント
        If Application.WorksheetFunction.CountA(Columns(columnCount)) = 0 Then
            '行の削除
            Columns(columnCount).Delete
        End If
    Next
 End Sub

1行目(フィールド名)を残したいので、
2行目以降に価がない列をすべて削除するマクロは
ございませんでしょうか?よろしくお願いします。

追記
2行目以降に価がない列は1行目(フィールド名)ごと
削除しても問題ありません。

 これを実際に動かしてみると、１行目も削除してしまうということですよね？
 自分には提示されているコードは「行」ではなく「列」を削除しているように見えるのですが･･･？
 Columns(columnCount).Delete←コレ

 (毛虫通過中)

 最早ColumnをRowに変えただけですが･･･

 Sub test2()
    Dim UsedCell As Range
    Dim Max_row, rowCount As Integer
    '使用しているセルの範囲を取得します
    Set UsedCell = ActiveSheet.UsedRange
    '最大の行番号を取得します
    Max_row = UsedCell.Cells(UsedCell.Count).Row
    For rowCount = Max_row To 2 Step -1
                             '~~これで2行目から最終行までが範囲になるかと。
        'Worksheet関数のCountAを使ってデータの個数をカウント
        If Application.WorksheetFunction.CountA(Rows(rowCount)) = 0 Then
            '行の削除
            Rows(rowCount).Delete
        End If
    Next

    '追加：もし、見出ししかなかったら見出しの行を削除
    If Max_row = 1 Then Rows(1).Delete
 End Sub

 (毛虫通過中)

 必ず見出しがあるのなら

 Application.WorksheetFunction.CountA(Columns(columnCount)) = 1

 で判定すれば良いのでは？

 (HANA)

(毛虫通過中)様
(HANA)様
ありがとうございます。解決しました。（DAR）

コメント返信：

[ 一覧(最新更新順) ]

[[20120417140010]] 『1行目(フィールド名)以外が空白の列を自動削除』（DAR） ページの最後に飛ぶ

[[20120417140010]]　『1行目(フィールド名)以外が空白の列を自動削除』（DAR）　ページの最後に飛ぶ