' [159.xls]



' [Module1] のコード
'★★☆　アドバンスフィルタを利用して集計する　☆★★

Option Explicit

Sub start()

    UserForm1.Show

End Sub


' [UserForm1] のコード
Option Explicit

Dim 最終行 As Integer
Dim flg As Boolean
Dim データ範囲 As Range
Dim ws As Worksheet

Private Sub ComboBox1_Change()
Dim 新データ As Range
Dim 新データ範囲 As String
Dim 検索条件範囲 As Range

    ListBox1.RowSource = "" '一旦 RowSource を消す
    damy削除                '既に作業シートがあれば削除
    flg = True              '最初はフラグを True をセット
    
    'データがシリアル値で表示されるのを日付形式に戻す
    ComboBox1.Value = Format(ComboBox1.Value, "yyyy/m/d")
    
    '上の行を実行すると Change イベントが発生してこの行以下が
    '再度実行されます、それを防ぐために2回目はマクロを抜けるようにします
    If flg = False Then Exit Sub
    
    Worksheets.Add          '作業用シートを挿入
    ActiveSheet.Name = "damy"
    Sheets("Title").Select
    
    With Sheets("damy")
    
        '抽出条件を揃える
        Set 新データ = .[A1]
        Set 検索条件範囲 = .[F1:F2]
        .[F1] = Sheets("Title").[G7]
        .[F2] = ComboBox1.Value

'        --------------- フィルタを実行 ------------------------------
        データ範囲.AdvancedFilter Action:=xlFilterCopy _
                        , criteriaRange:=検索条件範囲 _
                        , copyToRange:=新データ, unique:=False
                        
        '抽出されたデータ範囲の合計行を挿入
        最終行 = .[A65536].End(xlUp).Row
        .Cells(最終行 + 2, 3) = "=SUM(C1:C" & 最終行 & ")"
        .Cells(最終行 + 2, 2) = "合計"
        Label1.Caption = Format(.Cells(最終行 + 2, 3), "\\#,##0")
        
    End With

    'フィルタ結果範囲のアドレスを取得
    新データ範囲 = 新データ.CurrentRegion.Address
    
    ListBox1.RowSource = "damy!" & 新データ範囲
    
    flg = False             'Change イベント再発を回帰する
    
End Sub

Private Sub CommandButton1_Click()

    ListBox1.RowSource = "Title!" & データ範囲.Address
    
End Sub

Private Sub UserForm_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    If ActiveSheet.Name = "damy" Then
        Sheets("Title").Select
    Else
         For Each ws In Worksheets
            If ws.Name = "damy" Then
                ws.Activate
                Columns("A:F").EntireColumn.AutoFit
                Exit For
            End If
        Next
    End If

End Sub

Private Sub UserForm_Initialize()

    'フォーム起動時にプロパティー設定
    With ListBox1
    
        '列数をセットする
        .ColumnCount = 4
        
        '複数の列あるリストボックスの各列幅を設定
        .ColumnWidths = "50;60;50;60"
        
        Set データ範囲 = Sheets("Title").[D7:G15]

        'リストボックスに表示するデータ範囲を設定
        .RowSource = "Title!" & データ範囲.Address
    
    End With
    
    'コンボボックスに支払日データをセット
    最終行 = Sheets("Title").[G7].End(xlDown).Row   '最終セルを取得するテクニック
    ComboBox1.RowSource = "Title!G8:G" & 最終行
    
    ComboBox1.Style = fmStyleDropDownList
    Me.Caption = "株式会社○○ 取引情報"
    
End Sub

Sub damy削除()

        'もし、作業用シートがあれば削除する
        For Each ws In Worksheets
            If ws.Name = "damy" Then
                Application.DisplayAlerts = False
                ws.Delete
                Application.DisplayAlerts = True
                Exit For
            End If
        Next

End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

    damy削除
    Sheets("Title").Select

End Sub