ビジネスに役立つ講座や交流会を開催
社長・個人事業主からサラリーマン・主婦まで、どなたでも
アベノ塾

ホーム  会場案内  お問合せ

〒545-0052
大阪市阿倍野区阿倍野筋3-12-2
あべのクオレ1F
(ナガセキャリアプラザ アベノ校)
TEL 06-6647-5571

(2)subtotal関数

(a)エクセルの関数と概要

エクセルの関数は全件数はcount(A4:A16) すべての合計はsum(A4:A16)
フィルターをつけて抽出した選んだ件数はsubtotal(2,A4:A16)
選んだ合計はsubtotal (9,A4:A16)
2はカウントの引数9は合計の引数
VBAの場合はフォームを使って抽出を行います。
フィルターの方が各項目を自由に選べて楽に見えますがパソコンに慣れていない方にとってみればフォームでチェックボックス等で選ぶ方が使いやすいと思います。

(b)抽出フォーム

フォームを作る時は各オブジェクトに名前を付けないといけません。
フォーム名をfrmTyusyutuとします。
フォームをボタンとリンクするために標準モジュールに
Sub tyusyutu()
    frmTyusyutu.Show
End Sub
を書きます。
フォームが呼ばれた時に初期値を代入します。
日付・金額とも最小値・最大値を条件文のついた繰り返しで取得します。

次のプログラムを参考にしてフォームを作成してください。
Private Sub UserForm_Initialize()
    Dim i As Long
    Dim sdate As Date
    Dim edate As Date
    Dim skingaku As Long
    Dim ekingaku As Long
'日付
    sdate = Cells(4, 1)
    edate = Cells(4, 1)
    For i = 4 To 16
        If sdate >= Cells(i, 1) Then
           sdate = Cells(i, 1)
        End If
        If edate <= Cells(i, 1) Then
           edate = Cells(i, 1)
        End If
    Next
    txtSdate.Text = sdate
    txtEdate.Text = edate
'費目
    chkKoutuuhi.Value = True
    chkJimu.Value = True
    chkSyouhin.Value = True
'金額
    skingaku = 0
    txtSkin.Text = skingaku
    ekingaku = Cells(4, 3)
    For i = 7 To 21
        If ekingaku <= Cells(i, 3) Then
           ekingaku = Cells(i, 3)
        End If
    Next
    txtEkin.Text = ekingaku
End Sub

(c)データの抽出

3つの抽出条件(日付・費目・金額)の該当データを一気に取り出すことはできないことはないですが、例えばエクセルの3重IF文を考えてみてください。
1つの条件づつシートに取り出してはまた次の作業シートに取り出す方法であればわかりやすいと思います。
実行ボタンを押したときに抽出を行い最後に結果をもとの抽出箇所にコピーします。
Private Sub cmdJikkou_Click()
    Dim i As Long
    Dim kensu As Long
    Dim kingaku As Long
    Dim j As Long
    Dim lastrow As Long
'クリアにする
'作業シート
    For i = 1 To 13
        Worksheets("作業").Cells(i, 1) = ""
        Worksheets("作業").Cells(i, 2) = ""
        Worksheets("作業").Cells(i, 3) = ""
    Next
'作業1シート
    For i = 1 To 13
        Worksheets("作業1").Cells(i, 1) = ""
        Worksheets("作業1").Cells(i, 2) = ""
        Worksheets("作業1").Cells(i, 3) = ""
    Next

'抽出シートの表示
    For i = 4 To 16
        Worksheets("明細").Cells(i, 5) = ""
        Worksheets("明細").Cells(i, 6) = ""
        Worksheets("明細").Cells(i, 7) = ""
    Next

'全データの件数・金額
    For i = 4 To 16
        kensu = kensu + 1
        kingaku = kingaku + Cells(i, 3)
    Next
    Worksheets("明細").Cells(1, 3) = kensu
    Worksheets("明細").Cells(1, 5) = kingaku
    j = 1
'作業シートに取り出す
'日付の取り出し
    For i = 4 To 16
        If Worksheets("明細").Cells(i, 1) >= txtSdate.Text And Worksheets("明細").Cells(i, 1) <= txtEdate.Text Then
            Worksheets("作業").Cells(j, 1) = Cells(i, 1)
            Worksheets("作業").Cells(j, 2) = Cells(i, 2)
            Worksheets("作業").Cells(j, 3) = Cells(i, 3)
            j = j + 1
        End If
    Next
'費目の取り出し
    lastrow = Worksheets("作業").Cells(Rows.Count, 1).End(xlUp).Row
    j = 1
    For i = 1 To lastrow
        If chkKoutuuhi.Value = True Then
           If Worksheets("作業").Cells(i, 2) = chkKoutuuhi.Caption Then
                Worksheets("作業1").Cells(j, 1) = Worksheets("作業").Cells(i, 1)
                Worksheets("作業1").Cells(j, 2) = Worksheets("作業").Cells(i, 2)
                Worksheets("作業1").Cells(j, 3) = Worksheets("作業").Cells(i, 3)
                j = j + 1
           End If
        End If
        If chkJimu.Value = True Then
           If Worksheets("作業").Cells(i, 2) = chkJimu.Caption Then
                Worksheets("作業1").Cells(j, 1) = Worksheets("作業").Cells(i, 1)
                Worksheets("作業1").Cells(j, 2) = Worksheets("作業").Cells(i, 2)
                Worksheets("作業1").Cells(j, 3) = Worksheets("作業").Cells(i, 3)
                j = j + 1
           End If
        End If
        If chkSyouhin.Value = True Then
           If Worksheets("作業").Cells(i, 2) = chkSyouhin.Caption Then
                Worksheets("作業1").Cells(j, 1) = Worksheets("作業").Cells(i, 1)
                Worksheets("作業1").Cells(j, 2) = Worksheets("作業").Cells(i, 2)
                Worksheets("作業1").Cells(j, 3) = Worksheets("作業").Cells(i, 3)
                j = j + 1
           End If
        End If
    Next
'作業シートクリアにする

    For i = 1 To 15
        Worksheets("作業").Cells(i, 1) = ""
        Worksheets("作業").Cells(i, 2) = ""
        Worksheets("作業").Cells(i, 3) = ""
    Next
'金額の取り出し
    lastrow = Worksheets("作業1").Cells(Rows.Count, 1).End(xlUp).Row
    j = 1
    For i = 1 To lastrow
        If Worksheets("作業1").Cells(i, 3) >= Val(txtSkin.Text) And Worksheets("作業1").Cells(i, 3) <= Val(txtEkin.Text) Then
            Worksheets("作業").Cells(j, 1) = Worksheets("作業1").Cells(i, 1)
            Worksheets("作業").Cells(j, 2) = Worksheets("作業1").Cells(i, 2)
            Worksheets("作業").Cells(j, 3) = Worksheets("作業1").Cells(i, 3)
            j = j + 1
        End If
    Next

'作業シート抽出データの件数・金額
    lastrow = Worksheets("作業").Cells(Rows.Count, 1).End(xlUp).Row
    kensu = 0
    kingaku = 0
    For i = 1 To lastrow
        kensu = kensu + 1
        kingaku = kingaku + Worksheets("作業").Cells(i, 3)
    Next
    Worksheets("明細").Cells(2, 3) = kensu
    Worksheets("明細").Cells(2, 5) = kingaku

'抽出データの表示
    j = 4
    For i = 1 To lastrow
        Worksheets("明細").Cells(j, 5) = Worksheets("作業").Cells(i, 1)
        Worksheets("明細").Cells(j, 6) = Worksheets("作業").Cells(i, 2)
        Worksheets("明細").Cells(j, 7) = Worksheets("作業").Cells(i, 3)
        j = j + 1
    Next

    Unload Me
End Sub