オートフィルタ（抽出件数の取得・結果集計）AutoFilter メソッド

2015/09/16

ワークシート関数の Subtotal 関数の使い方

VBA には、オートフィルタの抽出件数を取得するプロパティやメソッドがないため、ワークシート関数の SABTOTAL 関数 を WorksheetFunction プロパティ から呼び出して使用します。さらに、SABTOTAL 関数 を使用して、抽出結果を対象にさまざまな集計を行うことが可能です。

【書式】

object.WorksheetFunction.Subtotal ( arg1, arg2 )

引数・戻り値

object ・・・対象となる Application オブジェクトを指定します。

arg1 ・・・集計方法を整数値で指定します。（省略不可）

値	対応する関数	内容
1	AVERAGE	平均
2	COUNT	数値を含むセル数
3	COUNTA	空白でないセル数
4	MAX	最大値
5	MIN	最小値
6	PRODUCT	積
7	STDEV	標本標準偏差
8	STDEVP	標準偏差
9	SUM	合計
10	VAR	不偏分散
11	VARP	標本分散

arg2 ・・・集計対象のセル範囲（Range オブジェクト）を指定します。（省略不可）

AutoFilter メソッド については、オートフィルタ（AutoFilter メソッド）等を参照してください。

オートフィルタの結果を集計する使用例

サンプルVBAソース　１

　
Sub Sample12_1_AutoFilter()

    Dim cnt As Long
    
    '抽出条件「合計」400点以上
    Range("B3").AutoFilter Field:=8, _
                           criteria1:=">=400"
                           
    '抽出件数を取得
    cnt = Application.WorksheetFunction.Subtotal _
                (3, Range("B3").CurrentRegion.Columns(1)) - 1
    
    MsgBox cnt

End Sub

Sub Sample12_1_AutoFilter()

Dim cnt As Long

'抽出条件「合計」400点以上

Range("B3").AutoFilter Field:=8, _

criteria1:=">=400"

'抽出件数を取得

cnt = Application.WorksheetFunction.Subtotal _

(3, Range("B3").CurrentRegion.Columns(1)) - 1

MsgBox cnt

End Sub

実行結果

サンプルVBAソース実行前

実行後

サンプルVBAソース　２

　
Sub Sample12_2_AutoFilter()

    Dim myRng As Range
    Dim Max_Total As Long, Min_Total As Long
    Dim Ave_Math As Double, Total_Math As Long
    
    Set myRng = Range("B3:J24")
    
    '抽出条件「登録番号」1010番以下
    myRng.AutoFilter Field:=1, _
                     criteria1:="<=1010"
    
    
    '8列（合計）の最高点を求める
    Max_Total = WorksheetFunction.Subtotal(4, myRng.Columns(8))
    
    '8列（合計）の最低点を求める
    Min_Total = WorksheetFunction.Subtotal(5, myRng.Columns(8))
    
    '6列（数学）の平均点を求める
    Ave_Math = WorksheetFunction.Subtotal(1, myRng.Columns(6))
                     
    '6列（数学）の合計点を求める
    Total_Math = WorksheetFunction.Subtotal(9, myRng.Columns(6))
    
    
    MsgBox "最高点（合計）：" & Max_Total & vbCrLf & _
           "最低点（合計）：" & Min_Total & vbCrLf & _
           "平均点（数学）：" & Ave_Math & vbCrLf & _
           "合計点（数学）：" & Total_Math
           
           
End Sub