[[20210316094208]]　『【VBA】アクティブセルの値でオートフィルター』（りん）　ページの最後に飛ぶ

『【VBA】アクティブセルの値でオートフィルター』（りん）

いろいろ探してみましたがわかりませんでしたのでお願いいたします。

すでにフィルターが設定されている名簿の一覧表があります。A列に「氏名」、B列に「性別」、C列に「都道府県」が入力されているのですが、ボタンひとつで、アクティブセルの値をフィルターしたいと考えています。特定のセルの値をフィルターするのではなく、そのとき指定したアクティブセルの値です。そのため、B列の「女性」という値でフィルターするときや、C列の「北海道」という値でフィルターすることもあります。実際にはこの表は20列ぐらいあります。
以上のような機能は可能でしょうか。よろしくお願いいたします。

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

 例えばこんな感じでしょうかね...

    Sub Test()
        If ActiveCell Is Nothing Then Exit Sub
        With ActiveCell
            If Not ActiveSheet.AutoFilterMode Then .AutoFilter
            .AutoFilter .Column - ActiveSheet.AutoFilter.Range.Column + 1, "=" & .Value
        End With
    End Sub

（白茶） 2021/03/16(火) 10:09

は、早いですね。。ありがとうございます！

フィルターできる時とできない時があります。
特に、最初フィルターしようとすると、
「実行時エラー'91' - オブジェクト変数または With ﾌﾞﾛｯｸ変数が設定されていません。」と出て、
デバッグとして「.AutoFilter .Column - ActiveSheet.AutoFilter.Range.Column + 1, "=" & .Value」を指します。
しかし「終了」を押して、再び同じセルでフィルターすると問題なくできます。
どうしてでしょうか。
（りん） 2021/03/16(火) 10:28

 どうしてでしょうね?
 ゴメンナサイ分かりません^^;

（白茶） 2021/03/16(火) 10:55

いえいえ、本当にありがとうございます。
少しは自分で考えてみます。
（りん） 2021/03/16(火) 10:57

違いがわかりました。
作っていただいたマクロは、フィルターが設定されている状態では作動せず、エラーになります。
一度デバッグが出て、終了ボタンを押すと、フィルターが解除され、そうするとマクロが作動になるようです。
（りん） 2021/03/16(火) 11:03

 ぶつかりましたが、そのまま
 If Not ActiveSheet.AutoFilterMode Then .AutoFilter
 は、
 If ActiveSheet.AutoFilterMode Then .AutoFilter: .AutoFilter Else .AutoFilter
 のほうがいいかもしれません
（´・ω・`） 2021/03/16(火) 11:03

 ちょっと考えてみたんですけど、やっぱわかんなかった^^;

 こちらExcel2010なんですけど、エラー出ないですね。
 [テープル]を設定してある表で且つオートフィルタ矢印未設定だったらエラー出ましたけど。

 (↓一応その部分だけ対応してみましたが、そういう問題ではない気がします)

    Sub Test2()
        If ActiveCell Is Nothing Then Exit Sub
        With ActiveCell
            If Not .ListObject Is Nothing Then
                .ListObject.ShowAutoFilter = True
            ElseIf Not ActiveSheet.AutoFilterMode Then
                .AutoFilter
            End If
            .AutoFilter .Column - ActiveSheet.AutoFilter.Range.Column + 1, "=" & .Value
        End With
    End Sub

（白茶） 2021/03/16(火) 11:46

 白茶さん
 単純な例でいうと、１つのシートに２つの独立な領域があって、
 一つめの領域ですでにAutoFilterがかかっているときに、
 ２つ目の領域のセルをアクティブにして実行するとエラーになります。

 なので、AutoFilterを使い回さないで、
 AutoFilterを解除してから新規でAutoFiterするのが安全なようです。
（´・ω・`） 2021/03/16(火) 11:56

 （´・ω・`）さん、どうも。いつもお世話になってます。
 なるほど確かにそれは想定してませんでした。

 >AutoFilterを解除してから新規でAutoFiterする
 これやっちゃうと、
 >B列の「女性」という値でフィルター
 して、更に
 >C列の「北海道」という値でフィルター
 する場合、
 B列の絞り込みが無くなっちゃいますので、使い回しで運用してたんですが...
 こりゃちょっと宿題かなぁ...　どうしょっかなー... (もはや自分の事しか考えてない^^; りんさんゴメンナサイ)

 兎にも角にも、ありがとうございました。

（白茶） 2021/03/16(火) 12:16

ええと(右往左往)。
白茶さんから最後にいただいたのでうまく行っているような気がします。
それと、ゴメンナサイ。表はテーブルになっています。。

さらに、大変恐縮ですが、追加でお聞きしてよろしいですか？
テーブルクリア(解除ではありません)のボタンがありまして、「ShowAllData」でクリアされるのですが、すべてのフィルタがクリアされた状態でボタンを押すとエラーになります。
こちらのエラーの解消方法はありますか？
（りん） 2021/03/16(火) 13:09

横からですけど、オートフィルタの話なのか、テーブルに設定されたフィルターの話なのかどっちなんでしょうか？
（タイトルからするとオートフィルタの話のような気もしますが）

オートフィルタの話だとすると、絞り込まれてない状態で「ShowAllData」をかけるとエラーになるということですが、２通りの解決方法があるとおもいます。

 (1)「On Error Resume Next」でエラーを無視する
 (2)絞り込まれているかどうか「ワークシートのFilterModeプロパティ」で判定して、真のときのみ「ShowAllData」する

 【参考】
http://officetanaka.net/excel/vba/tips/tips104.htm
http://officetanaka.net/excel/vba/tips/tips129.htm

（もこな２） 2021/03/16(火) 16:47

 あっちゃー。 ほったらかしでしたスミマセン^^;
 そりゃ右往左往しますよね。

 なるほどテーブル使ってたんですね。(それなら納得です)

 んで、
 そもそもオートフィルタが無かった場合の処理として
 ・オートフィルタを設置してでも絞り込みを続行するか
 ・何もしないで終わるか
 私自身の
 >>どうしょっかなー...
 のそこが正に争点にもなるのですが、

 汎用的な機能として活用するなら、先の（´・ω・`）さんご指摘のケース等も考えると、
 やっぱ余計な事はしない方がいいかなって思ってます。今は。

 「絞り込みしたい」って時点で、大抵の場合オートフィルタは既に設置済だろうし、
 極端な話、ちょっと絞り込みたかったが為に
 エリア1がListObject.AutoFilterでエリア2はActiveSheet.AutoFilterなんて状態になっちゃうのも
 運用面でどうかと思います。(仮に意図的にそうするなら、やはり既に設置済でしょうしねぇ)

 てな訳で、
 その点しか織り込んでない手抜きコードですけど一応貼り直しときます。(要らんかも知れませんけど)
 ご参考までということで。

    Sub Test3()
        If ActiveCell Is Nothing Then Exit Sub
        Dim AFRange As Range
        With ActiveCell
            If .ListObject Is Nothing Then
    '            On Error Resume Next 'やっぱ余計な世話は焼かないでおこう
    '            If Not ActiveSheet.AutoFilterMode Then .AutoFilter
    '            On Error GoTo 0
                If Not ActiveSheet.AutoFilterMode Then Exit Sub
                Set AFRange = .Worksheet.AutoFilter.Range
            Else
                .ListObject.ShowAutoFilter = True '←ココまで[余計なお世話]認定しなくてもイイよね..
                Set AFRange = .ListObject.AutoFilter.Range
            End If
            Set AFRange = AFRange.Offset(1, 0).Resize(AFRange.Rows.Count - 1)
            If Intersect(ActiveCell, AFRange) Is Nothing Then Exit Sub
            .AutoFilter .Column - AFRange.Column + 1, "=" & .Value
        End With
    End Sub

（白茶） 2021/03/16(火) 20:08

皆さま本当にどうもありがとうございました。
すべて解決いたしました。
フィルタは最終版にて作成しました。
もはや解読不能なレベルになってしまい、
地図もなく砂漠を彷徨う気分でしたが、
目的地にだけは着きました、というより
連れてっていただきました。
も少し勉強します。
感謝いたします。
そしてまた、よろしくお願いいたします。
（りん） 2021/03/17(水) 16:52

解決したようで何よりです。

結局、オートフィルタなのかよく分かりませんでしたが、オートフィルタが常に設定されているとしたら↓みたいな感じでもよいかもですね。（Date型のデータがあるとまずいですが・・・・）
（すべてシートモジュールに記述）

    Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
        '//オートフィルタのデータ部でダブルクリックしたときだけ、その値で絞り込み
        With AutoFilter.Range
            If Intersect(.Cells, .Cells.Offset(1), Target) Is Nothing Then Exit Sub

            Cancel = True
            .AutoFilter Field:=Target.Column, Criteria1:=Target.Value & ""
        End With
    End Sub
    '------------------------
    Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
        '//オートフィルタのデータ部で右クリックしたときだけ、絞り込みを全解除
        With AutoFilter.Range
            If Intersect(.Cells, .Cells.Offset(1), Target) Is Nothing Then Exit Sub

            Cancel = True
            On Error Resume Next
            ShowAllData
            On Error GoTo 0
        End With
    End Sub

（もこな２） 2021/03/17(水) 17:30

コメント返信：

[ 一覧(最新更新順) ]

[[20210316094208]] 『【VBA】アクティブセルの値でオートフィルター』（りん） ページの最後に飛ぶ

[[20210316094208]]　『【VBA】アクティブセルの値でオートフィルター』（りん）　ページの最後に飛ぶ