特定条件に該当する行を全て削除するVBAのプロシージャ

質問

お世話になります。（質問を書き換えました、前回ご対応いただいた方にはお詫び申し上げます）
プログラムから出力されたレポート(エクセル形式)の不要な行をフィルタ等で抽出し、削除したいのですがどのようにVBAのプロシージャを書けばよろしいのでしょうか？
具体的には
1:[D列]の"空欄"もしくは"---"をで始まるセル
2:[G列]の空欄のセル
3:[H列]のGで始まるセル
のいずれかに当てはまる行を全て削除したいのです。出されるレポートの総行数は毎回異なります。（自動記録では違うデータのレポートに対応できません）行数は毎回変わりますが100～200行くらいです。
毎日の作業ですので、出来ればVBAでマクロ化したいのですが。
自動記録でフィルタの設定までは出来ても、その後の行の削除をどう指定すればよいのかアイデアが浮かびません。抽出された行のA列にコメントを付して、その後コメントを付した行を削除しようとも考えましたが、どう書けばいいのか。。。
ちなみに全ての行に値が入っている列はありませんので、D列のみ全てのセルに手動で"1"を入力しようとも思っております。
よろしくお願いいたします。

回答No.6

onlyrom · ベストアンサー

No3、onlyromです。

＞二つ質問がございます。（２）から回答

＞(2)UsedRange.SpecialCells(xlCellTypeLastCell).Row
　　CurrentRegion.Row　の違いは何でしょうか？

ヘルプをじっくり眺めれば分かることですが、
CurrentRegionでは、空白行、空白列で囲まれた範囲を取得することになります。
質問で表のレイアウトがちゃんと提示してあれば、
そしてその表の中に、列全体、行全体が空白である行、列が
存在していないことは分かっていれば、CurrentRegionでいいわけですが
質問には、比較する列しか書いてありませんでしたので、大事をとって、UsedRangeの使用となりました。
先の回答にもそのことにちょこっと触れておりまするが。。。(^^;;;

＞(1)なぜ　For R = 2 To LastRow Step 1　としなかったか？

上から比較していく方法ではコードが見にくくなり、また余計なコードも必要になるからです。

これはコードを順を追って眺めていけば分かりますが実際に試してみるのが一番でしょう。
と、いうことで新しいブックで以下をお試しください。

Sheet1　の
Ａ１～Ａ９　に　１～９の連続数値を入れておく
Ｂ１～Ｂ９　に適当な数値を入れておく
セルＢ３とＢ４には　９９９　を入れておく
わかり易いように、Ｂ３，Ｂ４のセルには色も付けておく

（処理内容）
Ｂ列に　９９９　と入力されている行を削除する

標準モジュールに以下のコードを貼り付けして実行。

'-------------下から上へ処理する-------------------
Sub Test333()
　Dim R As Long
　For R = 9 To 1 Step -1
　　　If Cells(R, "B").Value = "999" Then
　　　　　　Rows(R).Delete xlShiftUp
　　　End If
　Next R
End Sub

'-------------上から下へ処理する-------------------
Sub Test555()
　Dim R As Long
　For R = 1 To 9
　　　If Cells(R, "B").Value = "999" Then
　　　　　　Rows(R).Delete xlShiftUp
　　　End If
　Next R
End Sub
'-------------------------------------------

どうでしょう、上から下へ処理していくと、セルＢ４の行が削除されないですよね。
このように単純に上から回すと、▼連続▼して削除の条件に
合致したセルがあった場合、削除されない行があるということです。
それを避けるためには余計なコードを増やす必要があるわけです。

●ということで、削除の基本は、「　下から上へ　」です。

因みに、Ｎｏ２の回答も上記Test555と同じものですから、そのままでは拙いことになります
以上。

お礼

onlyromさん、
とても分かりやすい説明文です。ありがとうございました。
実は自分で上からの式に書き換えて使ってみたら、なんと削除されない行があったのですよ。。。恐れ入りました。
また機会がございましたらよろしくお願いいたします。
本当にありがとうございました。

回答No.5

hige_082

難しく考えすぎです
単純に１行づつ、要るか要らないか判断し、要らなければ削除、要るなら次の行へと最後まで行えばよいのです
具体的なマクロは、#2のokormazdさんや、#3のonlyromさんマクロの方が理解参考になります
上から処理を行うか、下から処理を行うかの違いはありますが、基本的には1行づつ処理をしていて同じです
私的には、初心者にはokormazdさんマクロの方が理解しやすいのではと思います
okormazdさんのマクロが理解できれば、onlyromdさんの技が理解しやすいと思います

補足

hige_082さん、
アドバイスありがとうございます。
参考にさせていただきます。

回答No.4

mitarashi

前のご質問では却下されてしまいましたが、データ範囲が自動で設定されれば良いのでしょうか？下記は、データ範囲が、A6セルを含む表になっていて（ctrl+shift+:で自動認識される範囲）,フィルターオプションの抽出条件が、A1:C2にある事例です。自動記録の手直しなので、しなくても良いSelect等も多用しておりますが、ご参考まで。

Sub test()
Dim dataArea As Range
Dim criteriaArea As Range

Set dataArea = Range("A6").CurrentRegion
Set criteriaArea = Range("A1:C2")

dataArea.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
criteriaArea, Unique:=False
dataArea.Offset(1, 0).Resize(dataArea.Rows.Count - 1).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.EntireRow.Delete
ActiveSheet.ShowAllData
End Sub

補足

mitarashiさん、
毎回すみません、ありがとうございます。
自動記録でも色々なことが出来るのですね。
参考にさせていただきます。

回答No.3

onlyrom

オーソドックスにFor Nextでまわす方が簡単でしょう。
ただ、最終行がどの列で求められるかが書いてないので
UsedRangeを使い自動で求めることにします。

見出し：　１行目
データ：　２行目～～
シート：　Sheet1

とした場合。

'--------------------------------------------
Sub Test()
　Dim R As Long
　Dim LastRow As Long

　Sheets("Sheet1").Activate
　LastRow = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row

　For R = LastRow To 2 Step -1
　　　If Cells(R, "D").Value = "" Or _
　　　　　Left(Cells(R, "D").Value, 3) = "---" Or _
　　　　　Cells(R, "G").Value = "" Or _
　　　　　Left(Cells(R, "H").Value, 1) = "G" Then
　　　　　　　Rows(R).Delete xlShiftUp
　　　End If
　Next R
End Sub
'-------------------------------------------

以上。

お礼

補足とお礼が逆になってしまいました、すみません。
二つ質問がございます。
(1)なぜ、
　For R = 2 To LastRow Step 1
としなかったのでしょうか？

(2)
・・・.SpecialCells(xlCellTypeLastCell).Row
　と
・・・.CurrentRegion.Row
の違いは何でしょうか？

よろしくお願いいたします。

補足

onlyromさん、
とてもシンプルですね。初心者ですのでどうしても難しく考えてしまいつまずいてしまいます。
AかBかCであれば削除しなさい。。。それが思いつかなくて。
ありがとうございました、参考になりました。

回答No.2

okormazd

下記のようなことでしょうか。
SheetはActiveSheetにしてありますから、適宜変更をしてください。

Sub delrow()

Dim r0 As Integer, rmax As Integer, r As Integer, c As Integer

r0 = 1
c = 4 '列D

With ActiveSheet

rmax = Selection.SpecialCells(xlCellTypeLastCell).Row

For r = r0 To rmax
If .Cells(r, c) = "" Or Left(Cells(r, c), 3) = "---" Then
.Rows(r).Delete
End If

If .Cells(r, c + 3) = "" Then
.Rows(r).Delete
End If

If Left(.Cells(r, c + 4), 1) = "G" Then
Rows(r).Delete
End If
Next

End With

End Sub

補足

okormazdさん、
ご回答ありがとうございます。
参考になりました。色々条件を変えて試してみたいと思っております。
SpecialCells(xlCellTypeLastCell).Row
初心者ですので「SpecialCells(xlCellTypeLastCell).Row」が全く思いつきませんでした。CurrentRegionは思いついたのですが。。。
ありがとうございました。

回答No.1

imogasi

コード 内容
b d
c d
a y
c x
b d
a x
a z
c d
a x
のa-xの行を削除します。
Sub Macro1()
Range("A1:B10").Select
Selection.AutoFilter
Selection.AutoFilter Field:=1, Criteria1:="a"
'Selection.AutoFilter Field:=2, Criteria1:="x"
For Each cl In Selection.SpecialCells(xlCellTypeVisible)
'MsgBox cl
If cl.Column() = 1 Then
If cl.Offset(0, 1) = "x" Then
Rows(cl.Row).EntireRow.Delete
End If
End If
Next
End Sub
上記のIf cl.Offset(0, 1) = "x" Then
のところを、質問の１，２，３の条件で（OR条件？）
でIF文で判別してください。たとえばD列はcl.Offset(0, 3)で捉えられますから。

お礼

imogasiさん、
具体例を挙げてくださり、ありがとうございました。
offsetの使い方の勉強になりました。思いつきもしませんでした。
参考になります。