MW211 EXIT

devlog
ExcelVBA/オートフィルタ連動マクロ
2015年06月17日
ExcelVBA/オートフィルタ連動マクロ
オートフィルタの設定に伴ってマクロを起動する方法。

オートフィルタ変更イベント的なものはないので
代わりに「SUBTOTAL()」と再計算イベントを複合して対応する。

つまり、「SUBTOTAL()」で行件数を算出するようにして(第一引数=3)、
オートフィルタで行数が変動するのを再計算イベントで捕捉するという感じ。

以下のような形となる。
 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
【全表示の場合】
┌────┬──┬───┬───┬───┬───┐┌────┐
│抽出条件│キー│項目A │項目B │項目C │項目Z ││=SUBTOTAL(3,A:A)
├────┼──┼───┼───┼───┼───┤└────┘
│A       │A1  │あ    │      │      │ん    │
│A       │A2  │あ    │      │      │ん    │
├────┼──┼───┼───┼───┼───┤
│B       │B1  │      │い    │      │ん    │
│B       │B2  │      │い    │      │ん    │
├────┼──┼───┼───┼───┼───┤
│C       │C1  │      │      │う    │ん    │
│C       │C2  │      │      │う    │ん    │
├────┼──┼───┼───┼───┼───┤
│D       │D1  │      │      │      │ん    │
│D       │D2  │      │      │      │ん    │
└────┴──┴───┴───┴───┴───┘
 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
【抽出条件を「A」のみにした場合】
┌────┬──┬───┬───┐┌────┐
│抽出条件│キー│項目A │項目Z ││=SUBTOTAL(3,A:A)
├────┼──┼───┼───┤└────┘
│A       │A1  │あ    │ん    │
│A       │A2  │あ    │ん    │
└────┴──┴───┴───┘
 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
【抽出条件を「A」と「B」にした場合】
┌────┬──┬───┬───┬───┐┌────┐
│抽出条件│キー│項目A │項目B │項目Z ││=SUBTOTAL(3,A:A)
├────┼──┼───┼───┼───┤└────┘
│A       │A1  │あ    │      │ん    │
│A       │A2  │あ    │      │ん    │
├────┼──┼───┼───┼───┤
│B       │B1  │      │い    │ん    │
│B       │B2  │      │い    │ん    │
└────┴──┴───┴───┴───┘
 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
【シートに記述するマクロ】
┌──────────────────────────────────────┐
│Option Explicit                                                             │
│Const X_抽出条件 As Long = 1                                                │
│'===========================================================================│
│'  再計算時のイベント(SUBTOTAL(3,A:A)の設定が必須)                          │
│'    オートフィルタの変更を検出できないため                                 │
│'===========================================================================│
│Private Sub Worksheet_Calculate()                                           │
│    Dim 配列 As Variant                                                     │
│    Dim 判定結果 As Variant                                                 │
│    With ActiveSheet                                                        │
│        If Not .AutoFilterMode Then                     ' フィルタ未設定    │
│            .Columns("A:G").Hidden = False                                  │
│            Exit Sub                                                        │
│        End If                                                              │
│        If .AutoFilter.Filters.Count < X_抽出条件 Then  ' キー列に未設定    │
│            Exit Sub                                                        │
│        End If                                                              │
│        If Not .AutoFilter.Filters(X_抽出条件).On Then  ' 絞り込み未設定    │
│            .Columns("A:G").Hidden = False                                  │
│            Exit Sub                                                        │
│        End If                                                              │
│        ' 抽出条件の配列化                                                  │
│        Select Case .AutoFilter.Filters(X_抽出条件).Count                   │
│            Case 1:                                                         │
│                配列 = Array(.AutoFilter.Filters(X_抽出条件).Criteria1)     │
│            Case 2:                                                         │
│                配列 = Array(.AutoFilter.Filters(X_抽出条件).Criteria1, _   │
│                             .AutoFilter.Filters(X_抽出条件).Criteria2)     │
│            Case Else:                                                      │
│                配列 = .AutoFilter.Filters(X_抽出条件).Criteria1            │
│        End Select                                                          │
│        ' 表示変更                                                          │
│        .Columns("A:G").Hidden = False                                      │
│        判定結果 = Filter(配列, "=A")                                       │
│        If UBound(判定結果) = -1 Then                                       │
│            .Columns("C:C").Hidden = True                                   │
│        End If                                                              │
│        判定結果 = Filter(配列, "=B")                                       │
│        If UBound(判定結果) = -1 Then                                       │
│            .Columns("D:D").Hidden = True                                   │
│        End If                                                              │
│        判定結果 = Filter(配列, "=C")                                       │
│        If UBound(判定結果) = -1 Then                                       │
│            .Columns("E:E").Hidden = True                                   │
│        End If                                                              │
│    End With                                                                │
│End Sub                                                                     │
│'===========================================================================│
└──────────────────────────────────────┘
分類:ExcelVBA