Excel VBA オートフィルタで文字列と数値の絞り込み条件を取得する

オートフィルタ操作

今回は設定されたオートフィルタの文字列と数値の絞り込み条件を取得する方法をご説明します。

オートフィルタの絞り込み条件を完璧に取得するのはとても複雑です。

理由は、絞り込み出来る条件が多岐にわたり非常に多いからです。

今回ご説明するコードで日付や色を取得しようとした場合はエラーとなりますので、ご注意ください。

その他のオートフィルタの操作方法については、下記記事をご覧ください。

1.絞り込みされている列を取得する

オートフィルタで絞り込みされている列を取得します。

列を取得するには「Filterオブジェクト」の集まりの、「Filersコレクション」を操作します。

条件が指定されている列は「Onプロパティ」がTrueとなります。

次のようにB列とD列に絞り込みの条件が設定されているデータの、絞り込みされている列を取得します。

Sub Sample1()

Dim i       As Long
Dim myStr   As String

With ActiveSheet

    If .AutoFilterMode = True Then 'オートフィルタされているか判定
    
        For i = 1 To .AutoFilter.Filters.Count 'オートフィルターの列数を取得
        
            If .AutoFilter.Filters(i).On = True Then '絞り込みされているか判定
            
                myStr = myStr & i & "列目" & vbCrLf
                
            End If
            
        Next i
        
    End If
    
End With

MsgBox myStr

End Sub

「AutoFilterMode = True」でオートフィルタが設定されているか判定します。

オートフィルタが設定されていない場合に、「AutoFilter.Filters.Count」を取得しようとするとエラーとなるためです。

2.絞り込みされている項目を取得する

列の取得が出来ましたが、項目を取得する場合には次のように記述します。

取得した列の「AutoFilter.Range(i)」で項目を取得できます。

Sub Sample2()

Dim i       As Long
Dim myStr   As String

With ActiveSheet

    If .AutoFilterMode = True Then 'オートフィルタされているか判定
    
        For i = 1 To .AutoFilter.Filters.Count 'オートフィルターの列数を取得
        
            If .AutoFilter.Filters(i).On = True Then '絞り込みされているか判定
            
                myStr = myStr & .AutoFilter.Range(i) & vbCrLf
                
            End If
            
        Next i
        
    End If
    
End With

MsgBox myStr

End Sub

3.絞り込み条件を取得する

1条件ですと、こちらも比較的簡単です。

ただし、条件2つの場合は文頭でも記載していますが、指定する条件が多岐にわたり、すべてを取得しようとすると非常に複雑になるからです。

指定されている条件の数で取得方法が違いますので、順番にご説明します。

指定条件が1つの場合

1列に1条件の場合は次のように、各列「Filters」の「Criteria1」で取得します。

ActiveSheet.AutoFilter.Filters(1).Criteria1

先ほどの列を取得した方法を使い、次のようなデータの条件を取得します。

Sub Sample3()

Dim i       As Long
Dim myStr   As String

With ActiveSheet

    If .AutoFilterMode = True Then 'オートフィルタされているか判定
    
        For i = 1 To .AutoFilter.Filters.Count 'オートフィルターの列数を取得
        
            If .AutoFilter.Filters(i).On = True Then '絞り込みされているか判定
            
                myStr = myStr & .AutoFilter.Range(i) & "：" & .AutoFilter.Filters(i).Criteria1 & vbCrLf
                
            End If
            
        Next i
        
    End If
    
End With

MsgBox myStr

End Sub

「AutoFilter.Range(i)」で条件の指定されている項目を取得して、「AutoFilter.Filters(i).Criteria1」で指定されている条件を取得しています。

指定条件が2つの場合

指定条件が2つの場合は、「Criteria1」と「Criteria2」を取得します。

しかし、1つの場合と比べてとても複雑です。

理由は、条件1と条件2を繋げる「AND」や「OR」その他もろもろ・・・。

条件の定数が非常に多いからです。

この「AND]や「OR」の定数の取得は「Operatorプロパティ」を使用します。

次のように記述します。

 ActiveSheet.AutoFilter.Filters(1).Operator

条件に指定できる定数を一覧にしましたので、詳細は次の一覧をご覧ください。

定数数値説明
xlAnd1抽出条件1と抽出条件2の論理演算子AND
xlOr2抽出条件1または抽出条件2の論理演算子OR
xlTop10Items3抽出条件1で指定される最高値の項目数のレコード数
xlBottom10Items4抽出条件1で指定される最低値の項目数のレコード数
xlTop10Percent5抽出条件1で指定される最高値「％」のレコード数
xlBottom10Percent6抽出条件1で指定される最低値「％」のレコード数
xlFilterValues7フィルタの値
xlFilterCellColor8セルの色
xlFilterFontColor9フォントの色
xlFilterIcon10 フィルタアイコン
xlFilterDynamic11動的フィルタ
xlFilterNoFill12セルの色なし
xlFilterAutomaticFontColor13フォントの色自動
xlFilterNoIcon14アイコンなし

次のコードは各条件1と2を取得して、条件を繋げる定数を取得します。

今回はサンプルデータとして、B列の条件に「B店舗とD店舗」を指定していますが、コードは各定数に対応したコードとなっています。

Sub Sample4()

Dim i       As Long
Dim myStr   As String

With ActiveSheet

    If .AutoFilterMode = True Then 'オートフィルタされているか判定
    
        With .AutoFilter
        
            For i = 1 To .Filters.Count
            
                If .Filters(i).On = True Then '絞り込みされているか判定
                
                    myStr = myStr & .Range(i) & "：" & vbCrLf '条件指定項目を取得
                    
                    Select Case .Filters(i).Operator '条件の定数で分岐
                    
                    Case 0
                        myStr = myStr & .Filters(i).Criteria1 & vbCrLf
                    Case 1
                        myStr = myStr & .Filters(i).Criteria1 & " xlAnd " & _
                                .Filters(i).Criteria2 & vbCrLf
                    Case 2
                        myStr = myStr & .Filters(i).Criteria1 & " xlOr " & _
                                .Filters(i).Criteria2 & vbCrLf
                    Case 3
                        myStr = myStr & .Filters(i).Criteria1 & " xlTop10Items " & _
                                .Filters(i).Criteria2 & vbCrLf
                    Case 4
                        myStr = myStr & .Filters(i).Criteria1 & " xlBottom10Items " & _
                                .Filters(i).Criteria2 & vbCrLf
                    Case 5
                        myStr = myStr & .Filters(i).Criteria1 & " xlTop10Percent " & _
                                .Filters(i).Criteria2 & vbCrLf
                    Case 6
                        myStr = myStr & .Filters(i).Criteria1 & " xlBottom10Percent " & _
                                .Filters(i).Criteria2 & vbCrLf
                    Case 7
                        myStr = myStr & .Filters(i).Criteria1 & " xlFilterValues " & _
                                .Filters(i).Criteria2 & vbCrLf
                    Case 8
                        myStr = myStr & .Filters(i).Criteria1 & " xlFilterCellColor " & _
                                .Filters(i).Criteria2 & vbCrLf
                    Case 9
                        myStr = myStr & .Filters(i).Criteria1 & " xlFilterFontColor " & _
                                .Filters(i).Criteria2 & vbCrLf
                    Case 10
                        myStr = myStr & .Filters(i).Criteria1 & " xlFilterIcon " & _
                                .Filters(i).Criteria2 & vbCrLf
                    Case 11
                        myStr = myStr & .Filters(i).Criteria1 & " xlFilterDynamic " & _
                                .Filters(i).Criteria2 & vbCrLf
                    Case 12
                        myStr = myStr & .Filters(i).Criteria1 & " xlFilterNoFill " & _
                                .Filters(i).Criteria2 & vbCrLf
                    Case 13
                        myStr = myStr & .Filters(i).Criteria1 & " xlFilterAutomaticFontColor" & _
                        .Filters(i).Criteria2 & vbCrLf
                    Case 14
                        myStr = myStr & .Filters(i).Criteria1 & " xlFilterNoIcon " & _
                                .Filters(i).Criteria2 & vbCrLf
                    End Select
                    
                End If
                
            Next i
            
        End With
        
    End If
    
End With
    
MsgBox myStr

End Sub

非常に長いコードになっていますが、各定数「1～14」までを「Select Case」で分岐して取得できるようにしています。

「AutoFilterMode = True」でオートフィルタされているか判定して、「Filters(i).On = True」で絞り込みされている列を取得します。

「Select Case .Filters(i).Operator」の「Operator」で定数を取得して、「Select Case」で取得した定数に合わせて分岐処理をしています。

一応1~14すべて記載しましたが、便宜不要な定数は削除して頂いても動きます。

指定条件が3つの場合

条件が3つ以上の場合は指定する条件を配列に格納して指定します。

そして、「等しい(=)」指定しかできません。

そのため、3つ以上の場合は配列かどうかを判定して、配列の場合はその配列の中身を取得します。

3つ以上指定する場合は次のように記述します。

Sub Sample5()

Range("A1").AutoFilter 2, Array("店舗B", "店舗C", "店舗D"), xlFilterValues

End Sub

こちらの、3つの店舗で絞り込まれているデータの条件を取得するには次のように記述します。

Sub Sample6()

Dim myArray As Variant
Dim myStr   As String

    With ActiveSheet.AutoFilter.Filters(2)
    
        If IsArray(.Criteria1) = True Then
        
            For Each myArray In .Criteria1
            
                myStr = myStr & myArray & vbCrLf
                
            Next
            
        End If
        
    End With
    
    MsgBox myStr

End Sub

4.数値の絞り込みを取得する

数値も文字列と同様に取得出来ますが、取得結果を記載しておきます。

次のような売上で絞り込みされているデータの、絞り込み条件を取得します。

Sub Sample7()

Dim MyArray As Variant
Dim myStr   As String

    With ActiveSheet.AutoFilter.Filters(4)
    
        If IsArray(.Criteria1) = True Then
        
            For Each MyArray In .Criteria1
            
                myStr = myStr & MyArray & vbCrLf
                
            Next
            
        End If
        
    End With
    
    MsgBox myStr

End Sub

数値だからと言って特別なことはしていません。

5.すべての条件を取得するサンプルコード

今回は絞り込みの条件が指定された「列」、「項目」と指定条件が1つ、2つ、3つ以上の場合をそれぞれ説明しましたが、それらをすべて1まとめにした場合のサンプルコードです。

あくまで数値、文字列に対応したコードですので、A列の日付や色ではエラーとなります。

ロジックは「オートフィルタの設定を判定」、「絞り込みの判定」、「列を取得する」、「配列か判定」、「条件の数で分岐する」といった内容です。

とても長くなりますが、ご了承ください。

次のようなB列に3つの条件、C列に2つの条件を指定したデータを使用します。

Sub Sample8()

Dim i       As Long
Dim myStr   As String
Dim myArray As Variant

With ActiveSheet

    If .AutoFilterMode = True Then 'オートフィルタされているか判定
    
        With .AutoFilter
        
            For i = 1 To .Filters.Count
            
                If .Filters(i).On = True Then '絞り込みされているか判定
                
                    myStr = myStr & .Range(i) & "：" & vbCrLf '条件指定項目を取得
                    
                    If IsArray(.Filters(i).Criteria1) = True Then '配列か判定する
        
                        For Each myArray In .Filters(i).Criteria1 '(配列=条件3つ以上)
                        
                            myStr = myStr & myArray & vbCrLf
                            
                        Next
                        
                    Else
                    
                        Select Case .Filters(i).Operator '条件の定数で分岐
                        
                        Case 0
                            myStr = myStr & .Filters(i).Criteria1 & vbCrLf
                        Case 1
                            myStr = myStr & .Filters(i).Criteria1 & " xlAnd " & _
                                    .Filters(i).Criteria2 & vbCrLf
                        Case 2
                            myStr = myStr & .Filters(i).Criteria1 & " xlOr " & _
                                    .Filters(i).Criteria2 & vbCrLf
                        Case 3
                            myStr = myStr & .Filters(i).Criteria1 & " xlTop10Items " & _
                                    .Filters(i).Criteria2 & vbCrLf
                        Case 4
                            myStr = myStr & .Filters(i).Criteria1 & " xlBottom10Items " & _
                                    .Filters(i).Criteria2 & vbCrLf
                        Case 5
                            myStr = myStr & .Filters(i).Criteria1 & " xlTop10Percent " & _
                                    .Filters(i).Criteria2 & vbCrLf
                        Case 6
                            myStr = myStr & .Filters(i).Criteria1 & " xlBottom10Percent " & _
                                    .Filters(i).Criteria2 & vbCrLf
                        Case 7
                            myStr = myStr & .Filters(i).Criteria1 & " xlFilterValues " & _
                                    .Filters(i).Criteria2 & vbCrLf
                        Case 8
                            myStr = myStr & .Filters(i).Criteria1 & " xlFilterCellColor " & _
                                    .Filters(i).Criteria2 & vbCrLf
                        Case 9
                            myStr = myStr & .Filters(i).Criteria1 & " xlFilterFontColor " & _
                                    .Filters(i).Criteria2 & vbCrLf
                        Case 10
                            myStr = myStr & .Filters(i).Criteria1 & " xlFilterIcon " & _
                                    .Filters(i).Criteria2 & vbCrLf
                        Case 11
                            myStr = myStr & .Filters(i).Criteria1 & " xlFilterDynamic " & _
                                    .Filters(i).Criteria2 & vbCrLf
                        Case 12
                            myStr = myStr & .Filters(i).Criteria1 & " xlFilterNoFill " & _
                                    .Filters(i).Criteria2 & vbCrLf
                        Case 13
                            myStr = myStr & .Filters(i).Criteria1 & " xlFilterAutomaticFontColor" & _
                            .Filters(i).Criteria2 & vbCrLf
                        Case 14
                            myStr = myStr & .Filters(i).Criteria1 & " xlFilterNoIcon " & _
                                    .Filters(i).Criteria2 & vbCrLf
                        End Select
                        
                    End If
                    
                End If
                
            Next i
            
        End With
        
    End If
    
End With
    
MsgBox myStr

End Sub
スポンサーリンク
タイトルとURLをコピーしました