エクセルマクロで、空白行の一つ下の行を削除したい

質問

下記のようなデータがあるとき、空白行の一つしたの町名を一括で削除するには、どのようなマクロがあるでしょうか。
一定の行数なら私にもわかるのですが…、どなたか教えていただけないでしょうか。

町名　　　男　　女　　計

青山　　　 86　　183　 269　→これが下の四つの町の小計になります。
○○町　　25　　43　　68
××町　　11　　45　　56
▽▽▽　　30　　55　　85
◆◆◆　　20　　40　　60
　　　　　　　　　　　　　　　　 →空白行
北山町 　 41　　100 90　→これが下の二つの町の小計になります。
△△町　　11　　45　　56
■■■　　30　　55　　85

このような表が、8000行あります。必ず空白行の下の行が小計になります。
空白行の一つ下の行、「青山」と「北山」の行を、マクロを使って一度に削除できるでしょうか？

回答No.5

imogasi · ベストアンサー

ロジックを、行削除はせずに、別シートにほしいものだけ結果を出すほうが良い（ロジックが考えやすく安全）と思う。
ただ下記では、空白行を見つけるのに、Ｆｉｎｄメソッドを使っているので難しくなっているかも。
まねするなら十分テストして使ってください。
例データ
Ｓｈｅｅｔ１
町名 男 女 計

青山 86 183 269
○○町 25 43 68
××町 11 45 56
▽▽▽ 30 55 85
◆◆◆ 20 40 60

北山町 41 100 90
△△町 11 45 56
■■■ 30 55 85

本町 41 100 90
ＡＡ 11 45 56
ーー
コード
Sub test01()
Dim sh1, sh2
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
'--
k = 2
d = sh1.Range("A65536").End(xlUp).Row
sh1.Select
sh1.Range("A2").Select
sh1.Range("A1:A" & d).Select
Selection.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, MatchByte:=False, SearchFormat:=False).Activate
r1 = ActiveCell.Row
r0 = r1
Do
Selection.FindNext(After:=ActiveCell).Activate
r2 = ActiveCell.Row
MsgBox r2
If r2 = r0 Then GoTo p1 '先頭の空白行に帰ったら
sh1.Range(sh1.Cells(r1 + 2, "A"), sh1.Cells(r2, "D")).Copy sh2.Cells(k, "A")
k = k + r2 - r1 - 2 'Ｓｈｅｅｔ２で次の貼り付け行
r1 = r2
Loop
p1:
r2 = d + 1
sh1.Range(sh1.Cells(r1 + 2, "A"), sh1.Cells(r2, "D")).Copy sh2.Cells(k, "A")
End Sub
ーー
結果
Ｓｈｅｅｔ２
○○町 25 43 68
××町 11 45 56
▽▽▽ 30 55 85
◆◆◆ 20 40 60
△△町 11 45 56
■■■ 30 55 85
ＡＡ 11 45 56
ＣＣＣ 30 55 85

お礼

素晴らしいです。
元のデータはそのままで、取りたいところだけシート2に転記されました。
私には高度すぎて、まだ理解はできないですが解読してマネしたいと思います。
本当にありがとうございました。

回答No.4

mu2011

一案です。
マクロを使用しない方法ですが如何でしょうか。
対象の表範囲を選択→オートフィルタ→任意列のダウンリストボタンで空白セルを選択→抽出した行番号を選択して削除→オートフィルタフィルタ解除

因みにマクロが必要なら前操作をマクロ記録後、alt+F11押下して標準モジュールのmodule1をクリックしてみて下さい。

お礼

回答ありがとうございます。
私も空白行の削除の際、オートフィルターにはいつもお世話になっています。
また、編集→ジャンプから空白セルを選んで削除したりもします。

マクロ記録後、alt+F11押下して標準モジュールが出てくるのは知りませんでした。
参考になりました。ありがとうございました。

回答No.3

jcctaira

kuskus_2さん
こんにちは

A列が完全に空白なら削除するようにしています。
ご確認ください。

Sub 空白削除()
　　Range("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

お礼

すごいですね。
空白が一度でなくなりました。
いつもオートフィルターを使っていましたが、マクロでできるんですね。
ぜひぜひ、使わせていただきます。
ありがとうございました。

回答No.2

keithin

＞空白行の一つしたの町名を一括で削除するには

空白行（空白のセル）を調査して，その下の１行を削除します。

sub macro1()
　dim h as range
　on error resume next
　for each h in range("A1:A" & range("A65536").end(xlup).row).specialcells(xlcelltypeblanks)
　　h.offset(1, 0).entirerow.delete
　next
end sub
といった具合に。

＃「空白行」はホントに空っぽ行の事で，たとえば数式で""が計算されている等の意味であってはいけません。

お礼

綺麗に、各ブロックの空白行の一つ下の行がなくなりました。
私のイメージどおりです。
ただ、気をつけなくちゃいけないのはホントに空っぽの行でなくては駄目なのですね。
でも、空白行を調査してから削除するので、間違えて消しちゃったということはないようなので安心しました。
本当にありがとうございました。

回答No.1

xls88

必ず空白行があるということで
データ行の一番上の行にしてみました。

Dim rng As Range
Dim i As Long

Application.ScreenUpdating = False
Set rng = Range("A2", Range("D" & Rows.Count).End(xlUp))
Set rng = rng.SpecialCells(xlCellTypeConstants)
With rng
For i = .Areas.Count To 1 Step -1
.Areas(i).Rows(1).Delete
Next
End With
Application.ScreenUpdating = True

お礼

早々にありがとうございました。
なるほど、確かに空白行の一つ下の行は綺麗に削除されました。
ただ、連続していかないので繰り返しできるように考えたいと思います。
頑張ってみます。