개요

Excel의 필터 조건은 각 열마다 포치포치로 설정할 필요가 있다.
테이블에 대해서는 슬라이서라고 하는 것도 있지만, 이것도 또 포치포치 하고 있는 감은 부정할 수 없다.
필터 조건을 설정할 때, 목표는 값을 좁히는 것이 매우 많습니다. (라고 생각한다)

테이블의 데이터를 바라보고 있을 때, 「아, 이 값으로 필터하고 싶다」라고 생각했다고 한다.
그 때의 프로세스는 「이 값」을 기억해 헤더의 필터 설정을 열고,
데이터 목록에서 "이 값"을 찾아 선택합니다. 혹은 조건을 쓰거나 한다.

지금 바로 '이 값'을 보고 있는데 돌아다니는 생각이 매우 많다.
「이 값」은 바로 셀의 값이므로, 그것을 선택해 딱 할 수 없는가, 라고 하는 곳으로부터 생각해 냈다.

【추기】
표의 오른쪽 클릭 메뉴에 '선택한 셀 값으로 필터링'이라는 기능이 있습니다.
라고 코멘트로 가르쳐 주셨습니다.
이 기능은 단일 셀만 대상으로 하는 움직임이었으므로,
본 기사의 매크로는 「복수 선택할 수 있는 것」이 강해, 라고 하는 방향으로 살아 나누겠습니다.

메커니즘

단일 또는 복수의 셀을 선택한 상태로 실행하는 매크로이므로, 대상은 Selection.
테이블의 셀에 한정하여 실행한다. 따라서, Selection의 각 셀이 테이블에 포함되는지의 여부를 우선 판정한다.
별로 없다고 생각하지만, 복수 테이블에 걸쳐 있던 경우는 개별적으로 동작한다.
그런 다음 각 셀이 테이블에서 말하면이 열의 수를 계산하고 셀 값으로 필터를 활성화합니다.
즉, 복수 셀을 「이것과, 이것과, 이것으로」라고 선택해 포치하면 한순간에 필터할 수 있다.

아래 표를 볼 때 소지 캐릭터가 ケフカorモグ이고 분류가 楽器로 좁히고 싶다면

ケフカ、モグ、楽器 셀을 선택한 상태에서 실행


이제 딱 필터링

내용

【2020/1/25 수정했습니다】

선택 셀의 값을 취득하고 있던 개소입니다만, 셀의 서식 설정이 되어 있으면 필터할 수 없는 것이 있기 때문에selectionList(3) = trgRange.Value를 selectionList(3) = trgRange.Text로 변경했습니다.

Option Explicit

Sub filterBySelection()

    If TypeName(Selection) <> "Range" Then Exit Sub

    '選択セルを配列にしてCollectionに格納する
    Dim selectionList(1 To 3) As String '1:テーブル名, 2:列番, 3:値
    Dim selects As Collection: Set selects = New Collection

    Dim trgRange As Range
    For Each trgRange In Selection
        If Not trgRange.ListObject Is Nothing Then
            selectionList(1) = trgRange.ListObject.Name
            selectionList(2) = SET_TABLECOLUMN(trgRange) 'テーブルの列番に変換する
            selectionList(3) = trgRange.Text
            selects.Add selectionList
        End If
    Next

    If selects.Count < 1 Then Exit Sub

    '対象テーブル名を集計する
    Dim tableNames As Collection: Set tableNames = New Collection
    Set tableNames = GROUPING_TABLENAME(selects)

    '対象テーブルを順番に処理する
    Dim tableName As Variant, tb As ListObject
    For Each tableName In tableNames
        Set tb = ActiveSheet.ListObjects(tableName)
        Dim columns As Collection: Set columns = New Collection
        Set columns = GROUPING_COLUMN(tb, selects)

        'テーブルの列ごとにフィルターを適用する
        Dim column As Variant, sel As Variant
        For Each column In columns
            Dim arr() As String: arr = Split(vbNullString)
            For Each sel In selects
                If sel(2) = column Then
                    ReDim Preserve arr(UBound(arr) + 1)
                    arr(UBound(arr)) = sel(3)
                End If
            Next

            tb.Range.AutoFilter Field:=column, Criteria1:=arr, Operator:=xlFilterValues
        Next
    Next

End Sub

Function GROUPING_TABLENAME(col As Collection) As Collection
    Dim tableNames As Collection: Set tableNames = New Collection
    Dim tmp As Variant

    On Error Resume Next
    For Each tmp In col
        tableNames.Add tmp(1), tmp(1)
    Next
    On Error GoTo 0

    Set GROUPING_TABLENAME = tableNames
End Function

Function SET_TABLECOLUMN(trgRange As Range) As Long
    Dim wsCol As Long, tbCol As Long

    wsCol = trgRange.column

    If trgRange.ListObject.Range.column > 1 Then
        tbCol = wsCol - trgRange.ListObject.Range.column + 1
    Else
        tbCol = wsCol
    End If

    SET_TABLECOLUMN = tbCol
End Function

Function GROUPING_COLUMN(tb As ListObject, selects As Collection) As Collection
    Dim columns As Collection: Set columns = New Collection
    Dim tmp As Variant

    On Error Resume Next
    For Each tmp In selects
        columns.Add tmp(2), tmp(2)
    Next
    On Error GoTo 0

    Set GROUPING_COLUMN = columns
End Function

보충

Sub filterBySelection에서 실제로 필터 조건의 배열을 만드는 다음 부분.

For Each sel In selects
    If sel(2) = column Then
        ReDim Preserve arr(UBound(arr) + 1)
        arr(UBound(arr)) = sel(3)
    End If
Next

【2020/1/25 수정했습니다】
이 방법의 경우 첫 번째 요소는 공백이지만 공백은 필터 조건이 아니므로 문제가 없습니다.
죄송합니다, 공백은 마음에 드는 필터 조건이 되네요...
요소수 0의 배열을 만들어 두는 것으로 회피하는 수단으로 변경했습니다.
Dim arr() As String: arr = Split(vbNullString)
또, 테이블명이나 열번은 Collection에 넣는 것으로 중복의 제거를 실시하고 있지만,
조건의 값에 대해서는 중복되어도 문제없이 동작한다.