Excel VBA 2つの条件を満たした行を削除

質問

Excel2003を使用しています。

CSVファイルを元にデータを作りたく、まずは不要なデータを削除しています。

J列=0の行とJ列=0の行のA列の値と同じ値がA列に入力されている行を削除したく、J列=0のA列の値を一旦別シートに抽出し、その抽出したデータとA列のデータをループして、一致したら削除というコードを書きました。

もし可能であれば、一旦別シートに抽出せずに処理したいのですが、その場合、どのようにコードを書けばいいでしょうか？
よろしくお願いします。

回答No.2

watabe007 · ベストアンサー

>A列の値を一旦別シートに抽出し
A列の値を配列に格納しました。

Sub Test()
　　Dim v()
　　Dim LastRow As Long, i As Long, j As Long

　　LastRow = Cells(Rows.Count, "J").End(xlUp).Row
　　For i = 1 To LastRow
　　　　If Cells(i, "J").Value = 0 Then
　　　　　　j = j + 1
　　　　　　ReDim Preserve v(1 To j)
　　　　　　v(j) = Cells(i, "A").Value
　　　　End If
　　Next
　　For i = LastRow To 1 Step -1
　　　　If Not IsError(Application.Match(Cells(i, "A").Value, v, 0)) Then
　　　　　　Rows(i).Delete
　　　　End If
　　Next
End Sub

お礼

お礼が遅くなり、申し訳ありません。
回答ありがとうございます。

＞A列の値を配列に格納しました。

まさに、私が教えていただきたかった方法です。
勉強になります！ありがとうございました。

回答No.3

keithin

削除しなきゃならないＡ列の種類（数じゃない）がほどほど少なければ：
sub macro1()
　dim h as range
’application.screenupdating = false
　do until application.countif(range("J:J"), 0) = 0
　　set h = range("J:J").find(what:=0, lookin:=xlvalues, lookat:=xlwhole)
　　range("A:A").autofilter field:=1, criteria1:=cells(h.row, "A").value
　　activesheet.autofilter.range.offset(1).entirerow.delete shift:=xlshiftup
　　activesheet.autofiltermode = false
　loop
　application.screenupdating = true
end sub

多岐に渡るなら，別出しして一括削除の方が効率的です：
sub macro2()
　if application.countif(range("J:J"), 0) = 0 then exit sub

’ご利用のＣＳＶのレイアウトも何も情報が無いので
　range("1:1").insert
　range("A1") = "head"
　range("Z:Z").insert

’抽出
　range("J:J").autofilter field:=1, criteria1:=0
　range("A:A").copy range("Z1")
　activesheet.autofiltermode = false

’抽出
　range("A:A").advancedfilter action:=xlfilterinplace, _
　　criteriarange:=range("Z1:Z" & range("Z65536").end(xlup).row), _
　　unique:=false

’削除片付け
　range("A1").currentregion.entirerow.delete shift:=xlshiftup
　activesheet.showalldata
　range("Z:Z").delete shift:=xlshifttoleft
　range("A1").select
end sub

お礼

お礼が遅くなり、申し訳ありません。

＞削除しなきゃならないＡ列の種類（数じゃない）がほどほど少なければ

削除するA列の種類は1種類なので、こちらの方法でできそうです。
前回投稿した質問にも回答をいただきましたが、私が到底思いつかないような方法で、大変参考になります。
ありがとうございました！

回答No.1

tsubuyuki

すいません、意地悪な回答です。

Sub Sample()
Dim MaxRow As Long, MaxCol As Long
　　　　MaxRow = Cells(Rows.Count, 1).End(xlUp).Row
　　　　MaxCol = Cells(1, Columns.Count).End(xlToLeft).Column + 1

　　　　Range(Cells(2, MaxCol), Cells(MaxRow, MaxCol)).FormulaR1C1 = "=IF(RC[" & 10 - MaxCol & "]=0,RC[" & 1 - MaxCol & "],"""")"
　　　　Range(Cells(2, MaxCol + 1), Cells(MaxRow, MaxCol + 1)).FormulaR1C1 = "=COUNTIF(C[-1],RC[" & 0 - MaxCol & "])"

　　　　With Range("A1")
　　　　　　　　.AutoFilter
　　　　　　　　.AutoFilter Field:=MaxCol + 1, Criteria1:=">0"
　　　　　　　　Rows("2:" & MaxRow).SpecialCells(xlVisible).Delete Shift:=xlUp
　　　　　　　　.AutoFilter
　　　　End With

　　　　Columns(MaxCol).Resize(, 2).Delete
End Sub

以下、考え方です。

手作業でやるとしたらどうなるかなぁ？と考えたときに真っ先に思いつく流れが
「まずは削除の対象になる行の判断」ですね。

そんなわけで
> J列=0の行
を、まずは抜き出します。
単純に、適当なセル（例えばＮ列）に「=IF(J2=0,"",A2)」としてやれば、
「Ｊ列が０の行のＡ列」を書き出してくれますね（これも後に使います）。

続いて
> J列=0の行のA列の値と同じ値がA列に入力されている行
コレの判断ですが、先ほど書き出した「Ｊ列が０の行のＡ列」を使って、
これまた適当なセル（例えばＯ（オー）列）に「=COUNTIF(N:N,A2)」としてやれば、
「Ａ列の値がＮ列にあるか」判断できます。
「J列=0の行のA列の値と同じ値がA列に入力されていない行＝削除しない行」には
「０（ゼロ）」が返ってくる、と言う寸法です。
※「J列=0の行のA列」も自身のＡ列の値Ｎ列から数えますから、必ず「１以上」が返ります。
（ややこしい日本語ですが、なんとか読み取ってくださいませ。
　この辺りは「実際に関数式を入力してみると」少しは分かりやすいと思われます。）

つまり、ここまでやるとＯ（オー）列には
「削除しない行は０（ゼロ）、削除する行には１以上の数値」が返ってきます。

ここまで出来ればあとは簡単ですね。
Ｏ（オー）列に「１以上（０より大きい）」でフィルタをかけてやれば、
削除対象の行だけを表示することが出来ます。
あとは、抽出された行を削除して、フィルタを解除、
余分な列（Ｎ：Ｏ）も削除してやれば、スッキリします。

その「適当な列」を判断するために変数ＭａｘＣｏｌに最終列＋１列目を、
データがある最終行を判断するために変数ＭａｘＲｏｗに最終行を仕込んで、
一気にザザーっとやっつけてしまうように、また
> 一旦「別シートに抽出せずに」処理したい
を曲解し、「同じシートなら良いんだよね♪」というコンセプトで書いたのが、
上記の（かなり意地悪な）コードと言うことです。

長々と書きましたが、参考までにどうぞ。

お礼

お礼が遅くなり、申し訳ありません。
回答ありがとうございます。

行全体を削除するので、同じシート上ではよくないかなと思い、別シートに抽出したのですが、私の質問文の書き方だと“同じシートなら”とも解釈できますね。

意地悪な回答とのことで、正直なところ『しまった！』と思いつつ、丁寧に説明をしていただきまして、参考になりました。
ありがとうございました！