[[20221107223347]]　『セルの値でフィルターをかけ、かけた所以外を消す』（みふぃー）　ページの最後に飛ぶ

『セルの値でフィルターをかけ、かけた所以外を消すマクロ』（みふぃー）

T1のセルに　202210　が入っていたとします。年月を表しています。

H列の２行目から、202209，202210や、202211といった、
年月の値が入っています。

Ｔ1が202210のとき、
Ｈ列に202210以外の202209など２つ以上の違った値が入ると
以下のコードで202210だけが残るのですが
Ｈ列に202210しかない場合は、202210が入った行までも、なぜか消えてしまいます。
また、Ｈ列に202209しかない場合も、1004　該当するセルがみつかりません。というエラーが出てしまいます。

Ｔ1が202210のとき、Ｈ列に202210しかない場合はそのまま残し
Ｈ列に202209しかない場合は、該当なしのメッセージウィンドウを出したいです。

お力を貸してください。

書いたコードは以下です。

Sub T1セル値参照()

    Dim targetRange As Range
    Dim unDeleteRange As Range
    Dim deleteRange As Range

    'オートフィルタを設定する表の一番左上のセルを設定
    Set targetRange = Worksheets("データ").Range("H2")

    'オートフィルタの設定と表の左から8列目、Ｔ１セルの値で絞り込み
    targetRange.AutoFilter field:=8, Criteria1:=Range("T1").Value

    '絞り込まれた範囲(＝削除させない範囲)を取得
    With targetRange.CurrentRegion
        Set unDeleteRange = .Resize(.Rows.Count - 1).Offset(1, 0).SpecialCells(xlCellTypeVisible)
    End With

    'オートフィルタを解除
    targetRange.AutoFilter

    '絞り込まれた範囲(＝削除させない範囲)を非表示
    unDeleteRange.EntireRow.Hidden = True

    '表示されている範囲を削除
    With targetRange.CurrentRegion
        Set deleteRange = .Resize(.Rows.Count - 1).Offset(1, 0).SpecialCells(xlCellTypeVisible)
        deleteRange.EntireRow.Delete
    End With

    '絞り込まれた範囲(＝削除させない範囲)を表示
    unDeleteRange.EntireRow.Hidden = False

End Sub

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

こんばんわ　＾＾
AdovancedFilter
を使ってみられては。。。
多分ご希望通りかと。外していましたら、お許しを
m(__)m
（隠居Z） 2022/11/07(月) 23:13:26

↑大変失礼致しました、相済みません
忘れて下さい。m(__)m
（隠居Z） 2022/11/07(月) 23:33:56

１．あらかじめ、T1の値がH列にいくつあるか調べる[COUNTIFとかで]
２．0なら該当なしのMsgboxを出し、処理を終了
３．Ｈ列の行数[項目行は含まない]と同じならフィルターをかけるだけで
　　以降の削除処理を中断して抜ける[Exit Sub]
　　とかで、回避するとかでせうか。
試しておりません。本日は眠いので、また。。。＾＾；
m(__)m

（隠居Z） 2022/11/07(月) 23:46:01

 こんばんは

 下記のマクロ部分だけなら、正常に動作(意図した事)が
 できているのではないかと思いますです。

 なのでここから先を...もう一度よく検討されたら
 良いかな～と思います。

 今日は遅いので...明日になれば誰かがまたアドバイスして
 いただけるかと思いますよ。

 Sub T1セル値参照()

    Dim targetRange As Range
    Dim unDeleteRange As Range
    Dim deleteRange As Range

    Set targetRange = Worksheets("データ").Range("H2")
    targetRange.AutoFilter field:=8, Criteria1:=Range("T1").Value

 End Sub

（あみな） 2022/11/08(火) 00:07:44

３．Ｈ列の行数[項目行は含まない]と同じならフィルターをかけるだけで
　　↑
何もしなくていい、のまちがいです。＾＾；

で

このままお使いになるとすれば。下記のマクロを最初に呼び出せば
エラーの回避は出来ると。。。思います。。。←多分＾＾；
他にもいろいろ方法は有るでしょうが。ほんの一案です。(￣▽￣；)

 m(_ _)m
Option Explicit
Private Sub pRevent_Failure()
    Dim r As Range
    Dim jdv As Variant
    Dim cnt As Long
    With Worksheets("データ")
        jdv = .Range("T1").Value
        Set r = .Range("H2:H" & .Cells(.Rows.Count, "H").End(xlUp).Row)
        cnt = Application.CountIf(r, jdv)
    End With
    If cnt = 0 Then
        MsgBox "該当値無し"
        End
    ElseIf cnt = r.Count Then
        MsgBox "該当値のみです。"
        End
    End If
End Sub
（隠居Z） 2022/11/08(火) 08:02:28

外しているかも……
T1セルを除いてフィルターをかけ、抽出結果を削除します。
おそらく実際のデータは表で、H列以外にもデータがあると思います。

 >targetRange.AutoFilter field:=8, Criteria1:=Range("T1").Value
 　　　　　　　　　　　　　　　↑
 　　　　　　　　H列しかデータがなかったら、エラーになる。

 Sub test()
     Dim ws As Worksheet
     Dim LastR As Long

     Set ws = ThisWorkbook.Worksheets("データ")

     With ws
         If .AutoFilterMode = True Then .Range("H1").AutoFilter
         LastR = .Cells(Rows.Count, "H").End(xlUp).Row

         .Range("H1").AutoFilter 1, "<>" & .Range("T1")
 '        .Range("A1").AutoFilter 8, "<>" & .Range("T1")     'A列からデータがあった場合、修正

         If WorksheetFunction.Subtotal(3, .Range("H2").Resize(LastR - 1)) > 0 Then
             With .Range("H1").CurrentRegion.Offset(1, 0)
                 .Resize(.Rows.Count - 1).EntireRow.Delete
             End With
         Else
             MsgBox "該当なし"
         End If
         .Range("H1").AutoFilter
     End With
 End Sub
（フォーキー） 2022/11/08(火) 10:20:01

 続…コードを再検討しましたが

 ↓ 主題にあります
 ＞『セルの値でフィルターをかけ、かけた所以外を消すマクロ』

 ですが、仮に下記のレイアウトのように… H列に( 202210 以外の日付 ) があった場合ですが
 ( 202210の日付 ) 以外の行を削除する意図としては、完璧なコードに思えます。

 提示されたマクロは、本当にご自身で考えてされたものですか？
 何かを参考にされたのかもですが、‎「なかなかどうして」立派なコードだと思います。

 ◆参考レイアウト

    |[H]    
 [1]|       
 [2]|見出し
 [3]| 202210
 [4]| 202209
 [5]| 202210
 [6]| 202211
 [7]| 202209
 [8]| 202210

 ＞Ｈ列に202210しかない場合は、202210が入った行までも、なぜか消えてしまいます。
 いやいや違いますよ、消えてるのではなくて…非表示になった状態で止まっているのです。

 ＞また、Ｈ列に202209しかない場合も、1004　該当するセルがみつかりません。というエラーが出てし まいます。

 ↓ここでエラーですね。...そりゃそうです^^;
 Set deleteRange = .Resize(.Rows.Count - 1).Offset(1, 0).SpecialCells(xlCellTypeVisible)

 無い物を Set しようとしても、無理ですよ。
 ↓ここを見ればわかりますね。
 Set deleteRange =　← Nothing (なし)

 Sub 参考までに() '' ◆参考レイアウトにてマクロを実行すると…Debug.Print 結果は？

    Dim targetRange As Range
    Dim unDeleteRange As Range
    Dim deleteRange As Range
    Set targetRange = Worksheets("データ").Range("H2")
    targetRange.AutoFilter field:=8, Criteria1:=Range("T1").Value

    With targetRange.CurrentRegion
        Set unDeleteRange = .Resize(.Rows.Count - 1).Offset(1, 0).SpecialCells(xlCellTypeVisible)
        Debug.Print " 絞り込まれた範囲(Area1)を取得 " & unDeleteRange.Address
    End With
    targetRange.AutoFilter
    unDeleteRange.EntireRow.Hidden = True  '' (Area1)を非表示
    With targetRange.CurrentRegion
        Set deleteRange = .Resize(.Rows.Count - 1).Offset(1, 0).SpecialCells(xlCellTypeVisible)
        Debug.Print " 表示されている範囲を取得 " & deleteRange.Address '' 202210 以外
        deleteRange.EntireRow.Delete '' 表示されている範囲を削除
    End With
    unDeleteRange.EntireRow.Hidden = False '' (Area1)を表示

 End Sub

 Rem Debug.Print 結果 ( データ範囲が、A列 から J列 までとしたら )
 Rem 絞り込まれた範囲(Area1)を取得 $A$3:$J$3,$A$5:$J$5,$A$8:$J$8
 Rem 表示されている範囲を取得 $A$4:$J$4,$A$6:$J$7

（あみな） 2022/11/08(火) 10:35:56

 >書いたコードは以下です。

 の出所

https://excel-vba.work/2021/04/09/%E3%80%90vba%E3%80%91%E3%82%AA%E3%83%BC%E3%83%88%E3%83%95%E3%82%A3%E3%83%AB%E3%82%BF%E3%82%92%E5%88%A9%E7%94%A8%E3%81%97%E3%81%A6%E3%80%81%E6%9D%A1%E4%BB%B6%E3%81%AB%E4%B8%80%E8%87%B4%E3%81%97-2/
（今の日本人はこんな感じ） 2022/11/08(火) 21:12:30

■１
出どころ云々はさておき、提示されたコードは理解されていますか？
理解できていれば、そんな難しいことをせずに

 1. 抽出結果を別シートにコピペで退避する
 2. オートフィルタが設定されている範囲を含む行を削除する
 3. 1をコピペで書き戻す

でも、同じ結果になると思いますので、すこし考えてみては如何でしょうか。

■２
＞該当なしのメッセージウィンドウを出したい
既にあるCOUNTIF関数も有効ですが、オートフィルタの抽出結果をもとに、End(xlup).rowで項目行が返ってくれば抽出された行は無いと判断することでも対処出来ると思います。

（もこな２） 2022/11/09(水) 09:02:48

コメント返信：

[ 一覧(最新更新順) ]

[[20221107223347]] 『セルの値でフィルターをかけ、かけた所以外を消す』（みふぃー） ページの最後に飛ぶ

[[20221107223347]]　『セルの値でフィルターをかけ、かけた所以外を消す』（みふぃー）　ページの最後に飛ぶ