【Excel VBA】条件つき行削除

質問

Excel2003を使用しています。

システムからCSVで落としたデータで、データの並び方に規則性があるので、それを利用して、不要部分のデータをマクロで削除できないかと思い、質問させていただきます。

A列に『累計』を含む文字があった場合、その行のD列が0だったら、その行より上の行のA列に『計上日』と入力されている行までを削除するということをしたいです。
下記でいうと、2～5行までを削除したいです。

　　　A　　　　　B　　　　　C　　　　　D
1
2　計上日
3
4
5　累計　　　　　　　　　　　　　　　　0
6
7　計上日
8
9　累計　　　　　　　　　　　　　　1000

上記では、B列、C列には何も書いていませんが、実際はデータが入力されていたり、空欄だったりです。
D列が0の行を削除するコードはわかるのですが、さらに、条件が加わっても同じように処理は可能でしょうか？
よろしくお願いします。

回答No.3

zap35 · ベストアンサー

こんなマクロでもできそうです。念のため元のシートをコピーしてから実行するようにしました

Sub Macro1()
Dim idx As Long
Dim rng As Range
　Application.ScreenUpdating = False
　ActiveSheet.Copy after:=ActiveSheet
　For idx = Range("A65536").End(xlUp).Row To 1 Step -1
　　If Cells(idx, "A") = "計上日" Then
　　　Set rng = Range(Cells(idx, "A"), Cells(65536, "A")).Find(what:="累計", LookIn:=xlValues, lookat:=xlWhole)
　　　If Not rng Is Nothing Then
　　　　If rng.Offset(0, 3).Value = 0 Then
　　　　　Range(Rows(idx), Rows(rng.Row)).Delete
　　　　End If
　　　End If
　　End If
　Next idx
　Application.ScreenUpdating = True
End Sub

＞さらに、条件が加わっても同じように処理は可能でしょうか？
できると思いますが、その条件が指定されないとマクロは書けません。
ご自身で工夫してみてください。

あまりお急ぎの質問ではないようですが、その「工夫」を更に求めたいなら補足は早めにお願いします。
何日も経ってから補足されても再度巡回する保証はありませんので…

お礼

回答ありがとうございます。

教えていただいたマクロで試してみたところ、うまくいきました。

＞さらに、条件が加わっても同じように処理は可能でしょうか？
＞できると思いますが、その条件が指定されないとマクロは書けません。
＞ご自身で工夫してみてください。

書き方が紛らわしかったようで、申し訳ありません。
“D列が0の行を削除する”という条件に、今回のようにもうひとつ条件が加わっても…という意味で、書いていたつもりでした。
今回は教えていただいたコードを参考にさせていただき、無事完成しました。
ありがとうございました。

回答No.4

imogasi

ロジックの一例
ForNextでやると、行削除は最下行からやるほうが都合がいい。
コード
データのあるシートをアクチブシートにして実行。
Sub tet01()
d = Range("A65536").End(xlUp).Row
For i = d To 2 Step -1
If dl = "Y" And Cells(i, "A") = "計上日" And dl = "Y" Then
'この行が計上日で、累計行　AND　D列０が先にあり（ｄl＝”Y"）なら
MsgBox i & "-" & x & " 削除処理"
Rows(x & ":" & i).EntireRow.Delete
dl = "N" '累計とのペアー待ち状態解消
End If
If Cells(i, "A") = "累計" And Cells(i, "D") = 0 Then
dl = "Y" 'D列０で累計行現れた
x = i 'その行を記憶
End If
Next
End Sub
ーーー
例データ　質問者の意図に沿わない部分があるかも知れないが、ご容赦を
A列　　　B列　　　　　D列
集計 計数
1
計上日
3
4
累計 0＜ーーD列,以下累計の跡の数字はD列
計上日
5
6
累計 11
計上日
7
8
累計 0
12
計上日
13
14
累計 0
15
計上日
16
17
累計 20
計上日
18
累計 1000
ーーー
結果
集計 計数
1
計上日
5
6
累計 11
12
15
計上日
16
17
累計 20
計上日
18
累計 1000
ーー
少数例のテストしかやってないこと、
万一ロジックの不完全があるかも知れないが、コード数は少ないと思う。

お礼

回答ありがとうございます。

>ForNextでやると、行削除は最下行からやるほうが都合がいい。

手元にある参考書にも同様のことが書いてありました。

教えていただいたコードでも、うまくいきました。
MsgBox で、1回1回の削除の状態を確認できて、分かりやすかったです。
ありがとうございました。

回答No.2

qualheart

これでどうでしょう？
至極単純に作りましたが・・・

Sub Macro1()

Range("A:A").Select
endline = Selection.Find( _
What:="累計", _
After:=ActiveCell, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False _
).Row

n = 1
Do Until n = endline
If Cells(n, 1) = "計上日" Then
a = Cells(n, 1).Row
End If
If Cells(n, 1) = "累計" And Cells(n, 4) = 0 Then
Range(Cells(a, 1), Cells(n + 1, 1)).EntireRow.Delete
n = n - (n - a)
End If
n = n + 1
Loop
End Sub

お礼

回答ありがとうございます。

教えていただいたコードで試してみたところ、うまくいきました。
Do Until ～ Loopステートメントを使用してもできるのですね。
あまり使い慣れていないので、勉強になります。

ありがとうございました。

回答No.1

pkh4989

こんにちは。
以下のマクロを試してみてください。

Sub 削除()
　　Dim mR　　　　　As Long
　　Dim wR　　　　　As Long
　　Dim sR　　　　　As Long
　　'
　　With ActiveSheet
　　　　mR = Range("A" & Rows.Count).End(xlUp).Row
　　　　For wR = mR To 1 Step -1
　　　　　　If .Cells(wR, "A") = "累計" Then
　　　　　　　　If .Cells(wR, "D") = 0 Then
　　　　　　　　　　'開始行を求める
　　　　　　　　　　sR = Get_StartRow(wR)
　　　　　　　　　　.Rows(sR & ":" & wR).Delete Shift:=xlUp
　　　　　　　　　　wR = sR
　　　　　　　　End If
　　　　　　End If
　　　　Next
　　End With
End Sub
'
'開始行を求める
Function Get_StartRow(wI As Long) As Long
　　Dim wR　　　　　As Long
　　'
　　Get_StartRow = 0
　　With ActiveSheet
　　　　For wR = wI To 1 Step -1
　　　　　　If .Cells(wR, "A") = "計上日" Then
　　　　　　　　Get_StartRow = wR
　　　　　　　　Exit For
　　　　　　End If
　　　　Next
　　End With
End Function

お礼

回答ありがとうございます。

記載していただいたマクロを試してみたところ、うまくいきました。
Functionプロシージャは、ここでも何度か教えていただいたことがあるものの、自分で記述するところまではまだまだです。

おかげさまで、勉強になりました。
ありがとうございました。