VBA【範囲内が空白の行および空白の列を削除する方法】

範囲内が空白の行および空白の列を削除したいです。
どの会社にどの商品をいくつ送るかという表を作っているのですが、
完成後に送る数が0の会社や商品を削除して見た目をスッキリさせています。
この作業をマクロで行いたいです。

添付の画像でいうと、
企業5の行はすべて空欄なので行ごと削除し、
商品Dの列はすべて空欄なので列ごと削除したいです
それ以外の行、列には値が入っているので変更したくありません。
実際には商品も企業も長々と続いています。

このようになって欲しいです。
よろしくお願いいたします。

追記：大変申し訳ありません、伝え忘れていることがありました。
表の最終行には結合されたセルと運送会社が入っており、
表の最終列には総数を計上するための計算式が入っています。
このため、空白行・列を取得することができませんでした。

丸投げの質問という指摘があり、そうだなと思ったので試したことも記載していきます。
表題の通り特定範囲の空白行・列が削除したいと思い、空白行　削除などの単語で検索し、
空白のセルを含む行や列を削除する単純な方法や、空白行を取得するマクロを見つけたのですが、
行や列全体が空白というわけではないのがネックになってこちらで質問いたしました。

行動規範の内容に同意します

回答2件

ベストアンサー

データのあるセル範囲を取得して(CurrentRegionを使うと簡単)
そのセル範囲を For Each で Rows と Columns をループ処理
データがあるかどうかは Count関数で件数を数えで0件ならデータ無しと判断
データ無しの行または列を削除
というロジックで組んでみました。

vba
1Public Sub DelBlankRowCol()
2
3    Dim rng As Range
4    Set rng = Range("A1").CurrentRegion
5    Set rng = Intersect(rng, rng.Offset(1, 1))
6
7    Dim i As Long
8    For i = rng.Rows.Count To 1 Step -1
9        If WorksheetFunction.Count(rng.Rows(i)) = 0 Then
10           rng.Rows(i).EntireRow.Delete
11        End If
12    Next
13    For i = rng.Columns.Count To 1 Step -1
14        If WorksheetFunction.Count(rng.Columns(i)) = 0 Then
15           rng.Columns(i).EntireColumn.Delete
16        End If
17    Next
18End Sub

データが数値だけなの場合はこれでいいですが、文字もあるなら、CountA関数に変更してください。

追記

最終行、最終列にデータがある場合のコードは下記で。

vba
1Public Sub DelBlankRowCol()
2
3    Dim rng As Range
4    With Range("A1").CurrentRegion
5        Set rng = .Offset(1, 1).Resize(.Rows.Count - 2, .Columns.Count - 2)
6    End With
7
8    Dim i As Long
9    For i = rng.Rows.Count To 1 Step -1
10        If WorksheetFunction.Count(rng.Rows(i)) = 0 Then
11            rng.Rows(i).EntireRow.Delete
12        End If
13    Next
14    For i = rng.Columns.Count To 1 Step -1
15        If WorksheetFunction.Count(rng.Columns(i)) = 0 Then
16            rng.Columns(i).EntireColumn.Delete
17        End If
18    Next
19End Sub

投稿2020/12/08 12:26

編集2020/12/10 08:42

hatena19

総合スコア34075

nikuya

2020/12/10 07:20

回答ありがとうございます。追記したのですが、実は最終行と最終列にはデータがありました。ただ、こちらのCurrentRegionを利用する方法であれば問題ないと思うので、試してみます。

nikuya

2020/12/14 02:52

追記いただいたコードで目論見通り表を整理することができました。ありがとうございます。そのまま使うと商品や企業が消えてしまい、CountAを使うと結合されたセルがあることによって商品や企業の数が変わってしまうのでうまくいきませんでしたが、コードはそのままに表の消したくない行、列の枠外に数字を記入することで解決しました。

行動規範の内容に同意します

【Test1】
Booleanを使い空白が有ったらTrueにして、最後までTrueだったら行、列を削除する。
行と列で2回のループになります。

【Test2】
データーが無い　イコール　最終行、列の番号＝1になるので1になればその行、列を削除
こちらの方が簡単です。

vba
1Sub Test1()
2    Dim i As Long, j As Long
3    Dim Blank As Boolean
4    For i = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
5        '最終列まで空白が無いかを確認する
6        For j = 2 To Cells(1, Columns.Count).End(xlToLeft).Column
7            If Cells(i, j) = "" Then
8                '空白であればTrueにして続ける
9                Blank = True
10            Else
11                '空白でなかったらFalseにしてループを抜ける
12                Blank = False
13                Exit For
14            End If
15        Next j
16        'その行が最後までTrueであれば行削除
17        If Blank = True Then
18            Rows(i).Delete
19        End If
20    Next i
21
22    For j = Cells(1, Columns.Count).End(xlToLeft).Column To 2 Step -1
23        For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
24            If Cells(i, j) = "" Then
25                Blank = True
26            Else
27                Blank = False
28                Exit For
29            End If
30        Next i
31        If Blank = True Then
32            Columns(j).Delete
33        End If
34    Next j
35End Sub
36
37Sub Test2()
38    Dim i As Long
39    
40    '行の削除
41    For i = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
42        If Cells(i, Columns.Count).End(xlToLeft).Column = 1 Then
43            Rows(i).Delete
44        End If
45    Next i
46    
47    '列の削除
48    For i = Cells(1, Columns.Count).End(xlToLeft).Column To 2 Step -1
49        If Cells(Rows.Count, i).End(xlUp).Row = 1 Then
50            Columns(i).Delete
51        End If
52    Next i
53
54End Sub
55