Excel VBA 起点からの複数行一括削除

Excel VBAで末端までだと4万行くらいのデータを整理するものを組んで
います。初心者ゆえどなたかお詳しい方の知恵を拝借いたしたく。

元となるデータは15行が一塊であるデータブロックで構成されており、
14行目には"END"の文字があり、15行目には必ず空白行があります。
この15行のデータブロックが延々4万行繰り返しの形で存在しています。
どのデータブロックか判別できる数字が入っているのは1行目のE列
です。

データブロック一行目E列に含まれる特定の語句(IDNo.)を検索し、これを
起点として空白行までの15行一塊のデータブロックをまとめて削除でき
るものを作成しようと思ったのですが、一行ずつ削除するところまでしか
自力では分からず、これ以降どのように追記すれば良いか見当がつか
ない状態です。よろしくお願いします。

元データ
　　　　A　　 　B　　　C　　　　D　　　　E　　　　　F　　　G
1　　　aaa　　 bbb　　ccc　　ddd　　 (IDNo.)　　fff　　ggg
2　　　111　　222　　333　　444　　　555　　　666　　777
（略）
14　END
15　(空白行)
16　　AAA　　BBB　　CCC　DDD　 (IDNo.)　FFF　GGG
（略）
29　END
30　(空白行)


以下　検索したもの＋自分で追記してみた部分です。

Sub 特定ID削除()
With ActiveWorkbook.ActiveSheet
Const startrow As String = "1" '開始行を指定
Const col As String = "E" '識別文字が入力されている列
Dim Idx As Long
Dim keyWord
keyWord = Application.InputBox("削除対象の文字列を指定", Type:=2)
If TypeName(keyWord) <> "Boolean" And Len(keyWord) > 0 Then
For Idx = .Cells(65536, col).End(xlUp).Row To startrow Step -1
If InStr(.Cells(Idx, col).Value, keyWord) > 0 Then
' If Application.CountIf(Rows(Idx), "*" & keyWord & "*") > 0 Then
.Rows(Idx).Delete
End If
Next Idx
End If
End With
End Sub

No.3 ベストアンサー 回答者： heno-_- 回答日時： 2013/02/20 07:33

再三すみません。

１点勘違いしておりましたので、修正させてください。

> ３．TypeName(keyWord) <> "Boolean" And Len(keyWord) > 0
> 空白の入力や、キャンセルボタンが押された場合を除く分岐だと思いますが、
> シンプルに、戻り値が空白か否か判断すれば大丈夫です。

と書きましたが、キャンセルボタンが押された場合の処理を
除外するのを忘れておりました。
ご質問者様の書き方でも大丈夫ですし、
keyWord <> "" And keyWord <> "False" のように書いてもOKです。

大変失礼致しました。

--------------------------------------------------
Sub 特定ID削除()
Const blockNum As Integer = 15 ' １ブロックの行数
Const col As String = "E" ' 識別文字が入力されている列
Const startRow As Long = 1 ' 開始行
Dim endRow As Long ' 終了行
Dim Idx As Long
Dim keyWord

' 最終データブロックの先頭行を取得
endRow = Cells.SpecialCells(xlLastCell).Row - blockNum + 2

' 削除対象文字列を取得
keyWord = Application.InputBox("削除対象の文字列を指定", Type:=2)

' 検索＆削除処理
If keyWord <> "" And keyWord <> "False" Then
For Idx = endRow To startRow Step -blockNum
If InStr(Cells(Idx, col).Value, keyWord) > 0 Then
Range(Idx & ":" & Idx + blockNum - 1).Delete
Exit For '削除するブロックが１つだけの場合
End If
Next Idx
End If
End Sub
--------------------------------------------------

この回答へのお礼

一日悩んだ結果が一瞬で解決、思った通りの動作となり感動しました。
Excellentです！

色々やり方があるものですね、大変参考になりました。
このVBAだけでなく、仕事でもScriptを組めるようになる必要があり、
書籍等で色々調べたのですが、ばっちりこれ！といったコードがある
わけなく、途方にくれていました。自分でひとしきり悩んだ後、詳しい
方にかくも丁寧に回答頂いたため、素直に理解できました。
何度も丁寧に解説頂き、本当にありがとうございました。

お礼日時：2013/02/20 22:49

No.2 回答者： heno-_- 回答日時： 2013/02/20 04:34

No.1の者です。

気になったので、少し改良してみました。
--------------------------------------------------
Sub 特定ID削除()
Const blockNum As Integer = 15 ' １ブロックの行数
Const col As String = "E" ' 識別文字が入力されている列
Const startRow As Long = 1 ' 開始行
Dim endRow As Long ' 終了行
Dim Idx As Long
Dim keyWord

' 最終データブロックの先頭行を取得
endRow = Cells.SpecialCells(xlLastCell).Row - blockNum + 2

' 削除対象文字列を取得
keyWord = Application.InputBox("削除対象の文字列を指定", Type:=2)

' 検索＆削除処理
If keyWord <> "" Then
For Idx = endRow To startRow Step -blockNum
If InStr(Cells(Idx, col).Value, keyWord) > 0 Then
Range(Idx & ":" & Idx + blockNum - 1).Delete
Exit For '削除するブロックが１つだけの場合
End If
Next Idx
End If
End Sub
--------------------------------------------------

No.1 回答者： heno-_- 回答日時： 2013/02/20 04:22

Excel VBA初心者とのことですが、とても良くできていると思います。

色々調べながら頑張っておられるのでしょうね（*＾＿＾*）。

肝心の、複数行の削除ですが、

　Range(Idx & ":" & Idx + 14).Delete

の処理で問題ないかと思います。
Range関数は複数のセル・行・列を操作するのによく使いますので、
覚えておくと便利ですよ。


尚、蛇足ですが、いくつか気になった点がありましたので、書いておきます。

１．With ActiveWorkbook.ActiveSheet
アクティブなワークシートはWithステートメントを使わずとも、
Cells(***)のようにダイレクトに参照できます。

２．startrow変数
数値ですので、Long（Integer）型にしましょう。
また、変数名も単語で区切って「 startRow 」とすると分かり易いです。

３．TypeName(keyWord) <> "Boolean" And Len(keyWord) > 0
空白の入力や、キャンセルボタンが押された場合を除く分岐だと思いますが、
シンプルに、戻り値が空白か否か判断すれば大丈夫です。

４．65536
いきなり謎の数値が出てくると、プログラムが分かり辛いので、
startRowと同様に、これも定数として宣言しておくと良いです。
ファイルによって最終行が変わるなら、自動で取得する方法もあります。

５．Step -1
15行毎に固定で、特定の語句（IDNo.）が現れるなら、
一気に15行ずつ飛ばして検索した方が効率的です。

６．処理の停止
もし、削除するブロックが必ず１つだけでしたら、
削除処理が終わった後に、Exit Forでループを抜けましょう。
（ 複数ある場合は、最後まで検索が必要なので不要です ）

まとめると、以下のようになります。

--------------------------------------------------
Sub 特定ID削除()
Const col As String = "E" ' 識別文字が入力されている列
Const startRow As Long = 1 ' 開始行
Dim endRow As Long ' 終了行
Dim Idx As Long
Dim keyWord

' 最終データブロックの先頭行を取得
endRow = ActiveSheet.Cells.SpecialCells(xlLastCell).Row - 13

' 削除対象文字列を取得
keyWord = Application.InputBox("削除対象の文字列を指定", Type:=2)

' 検索＆削除処理
If keyWord <> "" Then
For Idx = endRow To startRow Step -15
If InStr(Cells(Idx, col).Value, keyWord) > 0 Then
Range(Idx & ":" & Idx + 14).Delete
Exit For '削除するブロックが１つだけの場合
End If
Next Idx
End If
End Sub
--------------------------------------------------

参考になりましたら、幸いです。