オートフィルタがかかっている列を検索する機能の不具合を改修した

以前にこのような記事を公開した。

www.excellovers.com

ところが使用していると、エラーが発生することがある。
必ず発生するわけでもなく、なかなかタイミングと時間が合わなかったがやっとこさ原因の特定と改修出来たので備忘録。

原因はオートフィルタの複数条件指定

原因はオートフィルタに「複数条件を指定」していると発生していた。

If .Filters(i).On Then ListValuesArray(3) = myObj.Filters(i).Criteria1

上記のコードはオートフィルタに条件が設定されている場合に配列に検索条件を格納するコード。

オートフィルタに条件が１つの場合は下記のような状態になっている。 文字列が返ってきている。

ところがオートフィルタに複数条件を設定すると、下記のように配列が返ってくる。

そのため複数の条件を指定した場合には上記コードで想定した文字列として取得できず、エラーになっていた。

対応後コード

標準モジュール

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
'---改修箇所②
          Dim myListObj As ListObject
          For Each myListObj In ActiveSheet.ListObjects
               If myListObj.Name = FilterType Then
                    Set myObj = ActiveSheet.ListObjects(FilterType).AutoFilter
                    ColumnsCount = ActiveSheet.ListObjects(FilterType).ListColumns.Count
               End If
          Next
     End If
          
     If Not myObj Is Nothing Then
          With myObj
               ReDim myVar(ColumnsCount)
               Dim ListValuesArray(1 To 3) As Variant
               For i = 1 To ColumnsCount
                    If AllColumnSearch Or .Filters(i).On Then
                         ListValuesArray(1) = .Range.Cells(i).Value
                         ListValuesArray(2) = .Range.Cells(i).Address(False, False)
                         ListValuesArray(3) = ""
'---改修箇所①
                         If .Filters(i).On Then
                              If IsArray(myObj.Filters(i).Criteria1) Then
                                   ListValuesArray(3) = Join(myObj.Filters(i).Criteria1)
                              Else
                                   ListValuesArray(3) = myObj.Filters(i).Criteria1
                              End If
                         End If
                         myVar(n) = ListValuesArray
                         n = n + 1
                    End If
               Next
          End With
     Else
          n = 0
     End If
     
     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 CommandButton1_Click()
     Unload Me
End Sub

Private Sub UserForm_Initialize()
     Me.TextBox1.SetFocus
     Me.ListBox1.ColumnCount = 3
     Me.ListBox1.ColumnWidths = "130;50;120"
     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)(1) Like "*" & Me.TextBox1.Value & "*" Then
               Me.ListBox1.AddItem myVar(i)(1)
               Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = myVar(i)(2)
               Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = myVar(i)(3)
          End If
     Next
End Sub
Private Sub ListBox1_Click()
'リストボックスに表示された検索結果をクリックすると、検索結果へ移動する
    Dim Adr As String
    Dim myWS As Worksheet
    Dim myList As Variant
    
    myList = ListBox1.List(ListBox1.ListIndex, 1)
    Adr = myList

    Range(Adr).Activate
End Sub

ISARRAY

配列が返ってきた時の対策として、変数の中身が配列かどうかを判定することで対応した。(改修箇所①)
IsArray関数を使用をすると引数に指定された変数の中身が配列の場合はTrue、配列でない場合はFalseが返ってくる。

IsArray関数

引数	内容
varname	変数が配列の場合は True を返し、それ以外の場合は False を返す

docs.microsoft.com

ユーザーフォーム開きっぱなし対応

上記のエラーとは別件だが、今回対応中に見つけたもう１つのエラーにも対応した。 オートフィルタ検索のユーザーフォームを開いたまま、別シートに移動して何らかの操作をするとエラーが発生してしまう。

処理の中に最初に参照したシートのオートフィルタやリストの名前を参照する箇所があり、新しいシートでオートフィルタを開いたまま再度処理するとエラーになっていました。

今回処理前にアクティブシートのオートフィルタやリストの存在チェックを行うことでエラーを回避するようにしました。(改修箇所②)

これで改めてオートフィルタをちょっと快適に使えるようになった。
なにか参考になれば幸いです。