[[20230706092609]]　『不良データの存在する行と、その上下1行ずつを抜ａx（ななし）　ページの最後に飛ぶ

『不良データの存在する行と、その上下1行ずつを抜き出したい』（ななし）

お世話になります。

A列からM列まで4万行程度の製品製造データが入力されています。
E列、またはG列に"0"が入力されている行は不良が生じている行です。
不良の原因を追究するため、不良行と、不良行の上下1行ずつを残し、
その他の行を削除、
または、
不良行と、不良行の上下1行ずつを抽出し、新規シートに保存したいです。

自分なりに調べて作成したコードが以下です。

 Sub DeleteRows()
 'E列またはG列の数字が0の行と、その行の上下1行ずつを残す

 'E列の数字が0の行を取得する
 Dim eRows As Range
 Set eRows = Range("E:E").FindAll(What:="0")

 'G列の数字が0の行を取得する
 Dim gRows As Range
 Set gRows = Range("G:G").FindAll(What:="0")

 'E列とG列の数字が0の行のリストを作成する
 Dim rowsToDelete As New Collection
 For Each row In eRows
     rowsToDelete.Add row
 Next
 For Each row In gRows
     rowsToDelete.Add row
 Next

 'リストに含まれる行を削除する
 For Each row In rowsToDelete
     Rows(row.Row).Delete
 Next

 End Sub

上記を実行すると、

 Set eRows = Range("E:E").FindAll(What:="0")
この箇所において、以下のエラーが生じます。

以下のエラーで実行できないため、コードを改善してください。
実行時エラー'438':
オブジェクトは、このプロパティまたはメソッドをサポートしていません。

どうすれば良いでしょうか…。
ご助力のほど、お願いいたします。

＜使用 Excel：Microsoft365、使用 OS：Windows10 ＞

＞どうすれば良いでしょうか…。
おちついて参考にしたサイトを読み返して、コードを再確認してください。

エラーメッセージのとおり、ExcelVBAには「FindAllメソッド」はないと思います。
想像するに「Findメソッド」の誤りではないでしょうか？

なお、ヒットするのを【すべて探す】には一工夫必要です。

 <参考>
http://officetanaka.net/excel/vba/tips/tips123.htm

（もこな２） 2023/07/06(木) 10:13:16

もう解決されましたですか。。。＾＾；
ほんの、一案ですが。。。(￣▽￣)
普通にループと条件分岐でオーソドックスに[←自分でそぉ思っているだけ＾＾；]
最初の行がゼロ
中間がゼロ、若しくは複数の連続したゼロ
最終行がゼロ
等に分けて、
[削除は面倒なので、抽出モードで（＾◇＾）ｖ]
ご勘案されても良いかもしれません。
ちょい
提案でした。でわ。お便りをお待ちいたします。
もう、ご覧になっていないかもですねぇ～～～(*^^*)
ちなみに、私、Find、あまり使った事が無くて、Application.Match()派です＾＾；
m(_ _)m
（隠居Z） 2023/07/10(月) 08:01:23

＞普通にループ
どのみち【すべて探す】には、ループ処理が必要だとおもいます。

＞Application.Match()派です
出来ないことはないとおもいますが、今回のように【セル】を特定する必要がある場合、Findメソッドも便利だとおもいます。
もっとも↓のように、コメントとコードが一致してないので、こちらが想像したのと違うことをしたいのかもしれませんが…

 ＞E列またはG列の数字が0の行と、その行の上下1行ずつを残す

 ＞'リストに含まれる行を削除する
 ＞For Each row In rowsToDelete
 ＞    Rows(row.Row).Delete
 ＞Next

（もこな２） 2023/07/10(月) 08:53:42

あ。。。はい。＾＾
決してFindを否定するものでは御座いません。ケースによっては
私も使いますです。(*^^*)
処理内容に付きましては、仰せの通りかと。
ご説明では残す　←　が　コードではゼロの行を削除したいご様子ですね。＾＾；
ふしぎだなぁ（＾◇＾）？
質問者様の、ご返信をお待ちいたしますです。＾＾；
でわでわ、また。m(__)m

（隠居Z） 2023/07/10(月) 09:35:49

 もう解決したのでしょうか？
 貴兄の案については、少し疑問があります。
 ・対象とする行の前後±1行を残して削除してしまったらまずいだろうし、
 ・それを別のシートにコピーしても、元のシートとの関係がわかりにくくなりませんか？

 そもそも、異常フラッグが立っているならば、
 ・その二つの列を選択状態にして、
 ・「検索」-「すべて検索」を掛ければよいのでは？
 ・候補一覧がダイアログ表示され、それをクリックすることで、異常セルにジャンプできます。
 ・そのうえで、直接、その場で解決をしたほうが効率が良くないですか？

 貴兄の作業案は、効果が割と乏しいわりに面倒な気がします。
 どうしてもということなら、
 ・フィルタオプションをかけてそれらの行を抽出する
 ・Set rng = 元のセル範囲.SpecialCells(xlCellTypeVisible).EntireRow
 ・Set rng2 = Union(rng, rng.Offset(-1), rng.Offset(1))
 ・rng2を別のシートにコピーします。
   （数式等が含まれているなら、値貼り付けですか？そのままで問題ないですか）
 とでもすればよいのではないでしょうか。

（xyz） 2023/07/10(月) 19:13:18

 私もxyzさんと同様の感想を持ちました。

 一案ですか、作業列を追加してそこで判定したらどうでしょうか。
 最終列の右隣のセル(N2)に下記を式を入力します。(1行目は項目名として)

 =IF(OR(E2=0,G2=0),"×",IF(OR(E1=0,G1=0,E3=0,G3=0),"△",""))

 フィルハンドル(セルの右下の四角)をダブルクリック
 これで、不良行には×、その前後の行には△が表示されます。

 必要に応じて、×△でフィルターをかける。
 前後行だけで原因が分からない場合、フィルター解除してさらに範囲をひろげて調査する。

 別シートに不良行とその前後を転記したいなのら、×△でフィルターをかけてコピーすればいいでしょう。

（hatena） 2023/07/10(月) 22:15:29

トピ主が戻ってくる気配がなさそうなので雑談的なお話として投稿します。

あまりない話だとはおもいますが、例えばエラー値を"0"として表示するようにしてあって、「0」と「"0"」を明示的に分けたいという話であればFindメソッドだと対応できないですね。

結果出力については、皆さんが仰るように元データをいじるのではなく別シートにでもコピーすることにしたほうがよいとおもいます。

    Sub 実験1()
        Dim i As Long
        Dim tmpROW As Range

        Set tmpROW = Rows(1)

        For i = 2 To Cells.SpecialCells(xlCellTypeLastCell).Row
            If Not IsError(Application.Match("0", Cells(i, "E"), 0)) Or Not IsError(Application.Match("0", Cells(i, "G"), 0)) Then
                Set tmpROW = Union(tmpROW, Rows(i).Offset(-1).Resize(3))
            End If
        Next i

        Worksheets.Add
        tmpROW.Copy ActiveSheet.Range("A1")
    End Sub
    '======================================================================
    Sub 実験2()
        Dim i As Long
        Dim tmpROW As Range

        Set tmpROW = Rows(1)

        For i = 2 To Cells.SpecialCells(xlCellTypeLastCell).Row
            If Not Union(Cells(i, "E"), Cells(i, "G")).Find("0", , xlValues, xlWhole) Is Nothing Then
                Set tmpROW = Union(tmpROW, Rows(i).Offset(-1).Resize(3))
            End If
        Next i

        Worksheets.Add
        tmpROW.Copy ActiveSheet.Range("A1")
    End Sub

（もこな２） 2023/07/18(火) 08:39:16

コメント返信：

[ 一覧(最新更新順) ]

[[20230706092609]] 『不良データの存在する行と、その上下1行ずつを抜ａx（ななし） ページの最後に飛ぶ

[[20230706092609]]　『不良データの存在する行と、その上下1行ずつを抜ａx（ななし）　ページの最後に飛ぶ