VBAで空白行を削除する。

質問

初めまして、VBA初心やです。なので具体的にご教授願います。環境WindoesXP SP3 EXCEL2010です。やりたい事Book1に空白行が沢山あるSheetが一枚あります。Sheetの中身は下記の通りです。
一行目に項目があります。n行目にも項目があります。nは、10個です。項目の下の行には、デターがあります。以下のようになっております。初めの位置はB2です。
　　　B2 　　 項目Ａ　項目B 項目C 項目D・・・・・
　　　項番１　データ1 データ2 データ3 データ4・・・・・・
　　　項番2　データ1 データ2 データ3 データ4・・・・・・
　　　項番3　データ1 空白　　データ3 データ4・・・・・・
　　　項番4　データ1 データ2　　空白 データ4・・・・・・
　　　項番5　データ1 データ2　　空白 空白・・・・・・
　　　項番6　データ1 データ2　　空白 空白・・・・・・
項番7　データ1 データ2　　空白 空白・・・・・・
項番8　空白 　　空白　　　空白 空白・・・・・・
・　　　　・ ・　　　　　・　　　・
　　　　Bn 　　 項目Ａ　項目B 項目C 項目D・・・・・
項番１　データ1 データ2 データ3 データ4・・・・・・
と続きます。この項番1は残して、項番8の様な空白セルが続く行だけ削除したいので、
以下のマクロを組みました。
Dim ii As Long
Dim MaxRow(1 To 100) As Long
Dim MaxCol As Long
'＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
MaxRow(1) = Cells(Rows.Count, 2).End(xlUp).Row
MaxRow(2) = Cells(Rows.Count, 21).End(xlUp).Row
MaxRow(3) = Cells(Rows.Count, 22).End(xlUp).Row
MaxRow(4) = Cells(Rows.Count, 23).End(xlUp).Row
MaxCol = Range("IV4").End(xlToLeft).Column
Application.ScreenUpdating = False
'＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
For i = MaxRow(1) To 3 Step -1 '配列にした。
'＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
For j = 1 To MaxCol Step 1
'＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
If Cells(4, j).Value = "" Then GoTo Label22
'Else
GoTo Label11
Label22:
Range(4 & ":" & MaxCol).Delete
Label11:
Next j
'End If
Next i
Application.ScreenUpdating = True
MsgBox "マクロが終了しました"
End Sub
しかし、ソートしてMaxRowの配列のいくつになるかを計算する処が判りません。
なので、空白行を削除できません。
ようするに、各項目(行)の空白セルがまちまちで(凹凸があり)、全ての項目が空白である処を探す事が出来ません。
何卒宜しくご教授願います。

回答No.2

K Kazz（@JazzCorp） · ベストアンサー

データ行数：＞０
Upto：データの先頭行
１：見出しなし
２：見出しあり

Sub DelBlankRows()
Const Upto = 2
Dim LastCellRow As Long
Dim kk As Long

Application.ScreenUpdating = False
LastCellRow = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
For kk = LastCellRow To Upto Step -1
If Application.WorksheetFunction.CountA(Rows(kk)) = 0 Then
Rows(kk).Delete
End If
Next kk
Application.ScreenUpdating = True
End Sub

お礼

始めまして、このご回答有難う御座います。一発で動作しました。ただ一点問題がありましたが、自分で解決しました。本当に有難う御座います。今後も宜しくお願い申し上げます。

回答No.1

tom04

こんばんは！

C列以降にデータがない行を削除すれば良いわけですよね？
一例です。

Sub 行削除()
Dim i As Long, j As Long
j = ActiveSheet.UsedRange.Columns.Count + 1
For i = Cells(Rows.Count, 2).End(xlUp).Row To 3 Step -1
If WorksheetFunction.CountA(Range(Cells(i, 3), Cells(i, j))) = 0 Then
Rows(i).Delete
End If
Next i
End Sub

「空白セル」がくせ者で、上記コードは生データのみ対応できます。
数式が入っていて見た目が空白の場合はCOUNTされます。

もしそういうセルがある場合は一度↓のマクロを実行した後に上記マクロを実行してみてください。

Sub 数式クリア()
Dim c As Range
For Each c In ActiveSheet.UsedRange
If c.HasFormula And c = "" Then
c.ClearContents
End If
Next c
End Sub

※　一旦マクロを実行すると元に戻せませんので、別Sheetでマクロを試してみてください。
参考になりますかね？m(_ _)m