excelでの対象範囲行削除

質問

excel2010

Aセルに入っている文字列で比較し、範囲抽出するマクロを作成しょうとしています。

何をやりたいかは、次の通りです。
Ａセルに見出しがついた行を先頭に、次の見出しの１行前までを
行で抜出したいのです。

例
下記はＡセルのデータのみを表示しています。

1行目　TEST_a
2行目　
3行目　
4行目　TEST_b
5行目　
6行目　
7行目　
8行目　TEST_c
9行目　
10行目　TEST_d
11行目

1~3行までを１つ目、4~7行を２つ目、8~9行を３つ目、10~11を４つ目で抜き出したいのです。

まず、4~7行目を抜き出すマクロは、
1~3行までを削除と下から8行目までを削除と考えました。

上から不要な部分を削除（1~3行までを削除）するマクロは下記の通りです。
Sub sample1()
'
' 上から下に検索
'
Dim x
Range("A1").Activate '最初のセル
Do Until ActiveCell.Value = "TEST_b" 'TEST_bが現れるまで
x = ActiveCell.Value
If x <> "TEST_b" Then 'TEST_bでないなら
ActiveCell.EntireRow.Delete 'その行を削除する
Else

ActiveCell.Offset(1).Activate '次の行
End If
Loop

End Sub

これは、正しく動作します。
上記を応用し、下から削除するマクロは次の通りとしました。

Sub sample2()
'下から検索

Do Until ActiveCell.Value = "TEST_c" 'TEST_cが現れるまで
y = Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row 'データ最下行取得

y = ActiveCell.Value
If y <> "TEST_c" Then 'TEST_cでないなら
ActiveCell.EntireRow.Delete 'その行を削除する
Else
ActiveCell.Offset(-1).Activate '次の行
End If

Loop
End Sub

このsample2を実行すると、応答が返ってきません。
何が悪いのか、どの様にしたら正しく動作するのか教えていただきたく。（１）

また、smple2だとTEST_cの行は残ってしまいます。
なので、下からTEST_cまでを削除するマクロは、
どの様に記述したらよいか教えていただきたく。（２）

以上２点、よろしくお願いします。

※マクロは初心者です。いろいろWEBで調べてみたのですが、いきづまりました。

回答No.2

dogs_cats · ベストアンサー

VBAの一例です。
TEST_bをセルA1に表示するまで行を削除する。
１．TEST_bが現れるまで上部セルを削除
２. TEST_bが現れるまで最終行から行を削除

Sub test() Sub test1()　どちらでも同じ結果が得られるます。
ご参考まで。

Sub test()

Dim i, MaxRow As Single

i = 1
Do While Range("A" & i).Value <> "TEST_b"
If Range("A" & i).Value <> "TEST_b" Then
Rows(i).Delete Shift:=xlUp
Else
Exit Do
End If
Loop

'A列最終行取得
MaxRow = Cells(Rows.Count, 1).End(xlUp).Row

i = MaxRow
Do While Range("A" & i).Value <> "TEST_c"
If Range("A" & i).Value <> "TEST_c" Then
Rows(i).Delete Shift:=xlUp
i = i - 1
Else
Rows(i).Delete Shift:=xlUp
Exit Do
End If
Loop

End Sub

Sub test2()

Dim i, MaxRow As Single

i = 1
Do While Range("A" & i).Value <> "TEST_b"
If Range("A" & i).Value <> "TEST_b" Then
Rows(i).Delete Shift:=xlUp
Else
Exit Do
End If
Loop

'A列最終行取得
MaxRow = Cells(Rows.Count, 1).End(xlUp).Row

i = MaxRow
Do While Range("A" & i).Value <> "TEST_b"
If Range("A" & i).Value <> "TEST_b" Then
Rows(i).Delete Shift:=xlUp
i = i - 1
Else
Exit Do
End If
Loop

End Sub

お礼

回答ありがとうございます。望み通りのVBAです。助かりました。

回答No.1

noname#206655

行を削除してしまっては、正しく動かないと思う。

セルの値は削除可能だと思う。

もしくは、削除したあと、セルの内容を判断すれば可能かな。

補足

行を削除してしまっては、正しく動かないと思う。

→何故なのか理由が知りたいところです。