オートフィルターがかかっている列を検索する機能にテーブルも検索できる機能を追加した

前回に引き続き機能の追加のお話。

www.excellovers.com

オートフィルターと同じようにデータを絞り込む機能がテーブル機能にも備わっている。

しかし現状の機能のままではテーブルのフィルタがかかっている列を抽出することが出来ない。

さてここでシンプルに機能がまとまっているオートフィルター検索に、テーブル検索機能を追加すべきか？

悩んでしまったのでtwitterで解答を投げかけたところ、以下のような結果になった

昨日作った「オートフィルターがかかっている列を検索」、そうだろうなぁとは思っていたが、テーブルには反応しない。
さて、テーブルにも同じユーザーフォームの中で対応させるべきか、別の機能としてフォームを作成するべきか。
— Kou Excelが大好きだ！ (@LoverExcel) 2020年4月19日

よし、それならばテーブルのフィルタがかかっている列抽出機能も追加してみよう。

完成品の挙動

f:id:ExcelLover:20200426135807g:plain 今までのオートフィルターはもちろんテーブルに対してもフィルタがかかっている列の抽出が出来ている。

コード

標準モジュール

Function FilterSearch(AllColumnSearch As Boolean, FilterType As String) As Variant
     Dim i As Long
     Dim n As Long
     Dim myVar As Variant
     Dim myObj As Object
     Dim ColumnsCount As Long
     
'①---------------------------------------------
     Set myObj = Nothing
     If FilterType = "オートフィルター" Then
          Set myObj = ActiveSheet.AutoFilter
          ColumnsCount = myObj.Filters.Count
     Else
          Set myObj = ActiveSheet.ListObjects(FilterType).AutoFilter
          ColumnsCount = ActiveSheet.ListObjects(FilterType).ListColumns.Count
     End If
'---------------------------------------------          
          
     With myObj
          ReDim myVar(ColumnsCount)
          For i = 1 To ColumnsCount
               If AllColumnSearch Or .Filters(i).On Then
                    myVar(n) = .Range.Cells(i).Value & "," & .Parent.Name & "," & .Range.Cells(i).Address(False, False)
                    n = n + 1
               End If
          Next
     End With

     If n = 0 Then
          myVar = Array()
     Else
          ReDim Preserve myVar(n - 1)
     End If
     FilterSearch = myVar
End Function

ユーザーフォーム

Private Sub ComboBox1_Change()
          Call ListboxAdd(ComboBox1.Value)
     Me.TextBox1.SetFocus
End Sub

Private Sub UserForm_Initialize()
     Me.TextBox1.SetFocus
     Call ComboboxAdd
     If ComboBox1.ListCount >= 1 Then Call ListboxAdd(ComboBox1.Value)
End Sub
    
Private Sub TextBox1_AfterUpdate()
     Call ListboxAdd(ComboBox1.Value)
End Sub

Private Sub CheckBox1_Change()
     Call ListboxAdd(ComboBox1.Value)
     Me.TextBox1.SetFocus
End Sub
    
Sub ComboboxAdd()
     If ActiveSheet.AutoFilterMode Then
          ComboBox1.AddItem "オートフィルター"
     End If

     Dim myListObj As ListObject
     For Each myListObj In ActiveSheet.ListObjects
          ComboBox1.AddItem myListObj.Name
     Next
     
     If ComboBox1.ListCount >= 1 Then ComboBox1.Value = ComboBox1.List(0)
End Sub
    
Sub ListboxAdd(Optional FilterType As String = "オートフィルター")
     Dim myVar As Variant
     myVar = FilterSearch(Me.CheckBox1.Value, FilterType)
     
     Me.ListBox1.Clear
     Dim i As Long
     For i = 0 To UBound(myVar)
          If myVar(i) Like "*" & Me.TextBox1.Value & "*" Then Me.ListBox1.AddItem myVar(i)
     Next
End Sub
    
Private Sub ListBox1_Click()
'リストボックスに表示された検索結果をクリックすると、検索結果へ移動する
    Dim Adr As String
    Dim myWS As Worksheet
    Dim myList As Variant
    
    myList = Split(ListBox1.List(ListBox1.ListIndex), ",")
    Adr = myList(2)

    Range(Adr).Activate
End Sub

FilterSearch関数

テーブル機能も対象とするので関数名をAutofilterSearch関数から改名。

引数にFiltertypeを追加した。

これはこの関数の呼び出し元である「ListboxAdd」から関数の対象となるオブジェクトがオートフィルタなのかテーブルなのかを受け取るようになっている。

受け取ったFiltertypeに応じて①の部分で取得するオブジェクトを変更している。

ユーザーフォーム

対象となるオブジェクトを選択するためのコンボボックスを１つ追加した。

それにともなってユーザーフォーム起動時にコンボボックスへオートフィルタないしテーブル名を記載するコードを追加した。

Private Sub UserForm_Initialize()
     Me.TextBox1.SetFocus
     Call ComboboxAdd
     If ComboBox1.ListCount >= 1 Then Call ListboxAdd(ComboBox1.Value)
End Sub