Excelのこととか色々

Excel のこととか楽天とか いろいろ書いてみます・・・

【Excel/VBAのこと29】AutoFilter 空白 or 空白以外で絞込み

   f:id:tuna-kichi:20200223230814p:plain

私がメインで使用している表は、何かしらの理由でデータがなく、空白のセルがいっぱいあります。

 

  空白セルのある表

 

このような表で空白セルで絞込み、または空白セル以外で絞り込むことが良くあります。

空白セルののチェックマークは一番下にあります。

 

一画面ですべての選択肢が収まっていれば良いのですが、

大抵スクロールバーを一番下まで移動させないと出現しません。

 

私は、この AutoFilter の小さい▼をクリックして、スクロールバーを下まで移動させて、

小さなチェックマークをクリックするのが好きではありません。

  空白セルで絞込み

 

なので、マクロ作って、リボンに登録して大きなボタンでクリックするようにしました。

 

                    

 

マクロ

AutoFilter が A列から設置してある場合

多くの表の場合は、列の増減はあっても先頭列は、A列 から始まっていると思います。

そのような表にはわりと簡単な記述で済みます。

------------------------------------------------

Sub AutoFilter固定列_空白セルで絞込み()

 Dim c As Long
 c = Selection.Column '選択したセルの列番号を取得
 Range("A1").AutoFilter Field:=c, Criteria1:="="

End Sub

 

AutoFilter が A列から設定してある表にのみ正常に動作します。

空白セル以外で絞り込む場合は、以下の通りです。

Range("A1").AutoFilter Field:=c, Criteria1:="<>"

------------------------------------------------

 

どんな表にも適用する場合

(のはずです・・・)

 

Sub AutoFilter空白セル選択()

 Dim AFAdrss As String 'AutoFilter の設置してある範囲を格納します
 Dim FirstC As String 'AutoFilter の先頭列番号を格納します
 Dim CrntField As String '現在選択されているセルの列番号を格納します
 Dim c As String '絞込みをしたい列番号を格納します
 Dim FirstRng As String '先頭列のセル番地を格納します
 Dim p As Variant '配列を使用します

 

 'AutoFilter の有無を確認して、設置されていなければ終了します
 If ActiveSheet.AutoFilterMode = False Then
  End
 End If

 With ActiveSheet.AutoFilter.Range
  FirstC = .Column 'AutoFilterの設置してある先頭列の列番号を取得します
  AFAdrss = .Address 'AutoFilterの設置してある範囲を取得します
 End With

 '絞り込みをしたい、列がAutoFilter の先頭列から何列目かを割り出します
 'AutoFilter 先頭列から現在選択している絞り込みをしたい列を引いて、
 '+1すれば左から何列目かわかります
 c = Selection.Column - FirstC + 1 

 

 '配列を使用します
 '上で取得した AutoFilter の範囲は、$A1$:$Z$59 のように取得されます
 'Split 関数を使って、:(コロン)で分けて、前半部分を使用します
 p = Split(AFAdrss, ":") 
 FirstRng = p(0)

 Range(FirstRng).AutoFilter Field:=c, Criteria1:="="
 '空白セル以外で絞り込む場合 Range(FirstRng).AutoFilter Field:=c, Criteria1:="<>"
End Sub

 

**********************************************************

 

このマクロを、個人用マクロブックの標準モジュールに記述して

リボンに登録して、どんな Excel にも使えるようにしましょう。 

  リボンに登録

 

---------------------------------------------------------------------

 ※2020.10.29 空白以外のセルを選択する記述修正 <> を追記
 Range(FirstRng).AutoFilter Field:=c, Criteria1:="<>"

 

 

個人用マクロブックについてはこちら

www.tuna-kichi.com

 

リボンに登録についてはこちら

www.tuna-kichi.com

 

_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/