【Excel VBA】一定数以上の空白行を削除する

質問

お世話になります。
現在、見積用のVBAを作成していますが、行き詰った為、質問いたします。

＜前提＞
・作成する見積明細は横8列で、行数は入力する項目数により可変です。
・印刷して提出する為に、カテゴリごとに小計をページ最下行に挿入します。
（1ページあたりの行数は見出しを含めず20行です。）
・各カテゴリ内の項目数により、項目の最下行と小計行の間に相応の空白行ができます。
（例１） 項目が5個の場合は14行の空白行、その下に小計が表示される（ページ数は1ページ）
（例２） 項目が25個の場合は14行の空白行、その下に小計が表示される（ページ数は2ページ）

＜問題＞
・19行以下の空白行はそのままにし、20行空白ができた場合に該当行を削除して、シートを整えることが目的です。（21行以上空白ができることはありません）
・20行の空白はランダムに発生し、数も不定です。

下から最下行を探して、その一つ上の行から更にその上を探して、
差分が20の場合に該当行を削除する・・・
を繰り返して、上に上がっていく処理をイメージしますが、力不足でまとめられません。

書き方のヒントだけでもご教示ください。
何卒、宜しくお願いします。

回答No.1

keithin · ベストアンサー

＞20行空白ができた場合に該当行を削除

ホントにそれでよいのなら，こんな具合でしょうか。

簡易版：「空白行」であるか否か，たとえば項目列のＡ列の記入の有無で判定できる
sub macro1()
　dim h as range
　dim lastRow as long

　lastrow = range("A65536").end(xlup).row
　on error resume next

　for each h in range("A1:A" & lastrow).specialcells(xlcelltypeblanks).areas
　　if h.rows.count >19 then
　　　h.entirerow.delete shift:=xlshiftup
　　end if
　next
end sub

ついでに：「空白行」であるか否か，全列をくまなく調べたい
sub macro2()
　dim h as range
　dim i as long
　for i = 1 to 8
　　range("A:H").autofilter field:=i, criteria1:="="
　next i
　on error resume next

　for each h in activesheet.autofilter.range.specialcells(xlcelltypevisible).areas
　　if h.rows.count > 19 then
　　　h.entirerow.delete shift:=xlshiftup
　　end if
　next
　activesheet.autofiltermode = false
end sub

＃余談
＞20行空白ができた場合に該当行を削除

１ページ２０行の設定で各ページの最終行に小計欄があるのに，２０行の空白になるのですか？
もちろん削除の判断基準だけのお話なので，修正や応用はたやすいとは思いますが。

お礼

早速のご回答、ありがとうございます！
お陰様で目的を果たすことができました。

> １ページ２０行の設定で各ページの最終行に小計欄があるのに，２０行の空白になるのですか？

説明がうまくなくて申し訳ないです。

小計欄は各ページにあるのではなく、各カテゴリの最後に挿入しているので、
例えば、25個の項目があるカテゴリであれば、
最初の1ページ目は、見出しが1行、次に項目が19行、
2ページ目に項目が6行、空白行が13行、小計が1行されます。

余談ですが、作成中の見積ファイルは、ボタンクリック時に
入力シートから印刷シートに入力した見積が転記される仕組みにしています。
その際、見出しフラグを設定した行間の小計を上のイメージで挿入したり、
印刷用の書式調整等をしたりしています。

ただ、小計行を挿入する処理が不完全で、項目数によって空白行が
20行発生してしまう場合があり、最初はそこを直そうとしたのですが、
出来上がった印刷シートから空白行を20行消す方が早そうだと思い、
今回の質問に至った次第でございます。

ともあれ、これで先に進めます。
ありがとうございます！