【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 回答日時： 2008/10/17 01:19

こんなマクロでもできそうです。

念のため元のシートをコピーしてから実行するようにしました

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の行を削除する”という条件に、今回のようにもうひとつ条件が加わっても…という意味で、書いていたつもりでした。
今回は教えていただいたコードを参考にさせていただき、無事完成しました。
ありがとうございました。

お礼日時：2008/10/17 17:24

No.4 回答者： imogasi 回答日時： 2008/10/17 08:39

ロジックの一例

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回の削除の状態を確認できて、分かりやすかったです。
ありがとうございました。

お礼日時：2008/10/17 17:28

No.2 回答者： qualheart 回答日時： 2008/10/16 17:07

これでどうでしょう？

至極単純に作りましたが・・・

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ステートメントを使用してもできるのですね。
あまり使い慣れていないので、勉強になります。

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

お礼日時：2008/10/17 17:17

No.1 回答者： pkh4989 回答日時： 2008/10/16 16:41

こんにちは。

以下のマクロを試してみてください。

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プロシージャは、ここでも何度か教えていただいたことがあるものの、自分で記述するところまではまだまだです。

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

お礼日時：2008/10/17 17:10