Excelの横方向フィルタ

Excelには縦方向のフィルタ機能がありますが、横方向のフィルタがありません。

横方向のフィルタはVBA（マクロ）を使って実現できますので、紹介します。

たとえば、こんなエクセルのデータがあるとしましょう。

これは所属システムエンジニアのスキル表サンプルです。

例ではメンバーが数人ですが、100人も1000人もいたら大きなデータになります。

たとえば、円屋さんがプロジェクトから離任することになりましたという時、似たスキルセットのメンバーを代理で参加させたいとなると、大きなデータから探すのは大変ですね。

上記の表でフィルタができれば、簡単に見つけることができると思います。

一番ポピュラーな方法は、Excelのこの表をコピーして、別シートに張り付ける時に行と列を入れ替えます。そして、Excelデフォルトのオートフィルタで絞り込めばいいですね。

ですが、今回は行と列を入れ替えることなく実現するために横フィルタをVBAで作成してみます。

VBAで作成したSampleコード

色々コントロールができるようにしたいので、右図のようなユーザーフォームを作成します。

ListBox1には、選択した行に含まれる値のリストを表示させます。

CommandButton1はフィルタの実行をさせるAction処理を実装します。

CommandButton2はフィルタを解除するAction処理を実装します。

以下はVBAコードです。

Dim rowno, colno As Integer

'=================================================
'フィルタ処理
'=================================================
Private Sub CommandButton1_Click()
    Dim colAlfa, compData As String

    With UserForm1.ListBox1
        If .ListIndex < 0 Then
            .ListIndex = 0
        End If

        selectedvalue = .List(.ListIndex, 0)
        For i = colno To Columns.Count
            nowcol = Cells(1, i).Address(True, False)
            colAlfa = Left(nowcol, InStr(nowcol, "$") - 1)

            If Columns(colAlfa).Hidden = False Then
                If TypeName(Cells(rowno, i).Value) = "Integer" Then
                    compData = Trim(Str(Cells(rowno, i).Value))
                Else
                    compData = Cells(rowno, i).Value
                End If
                If compData = selectedvalue Then
                    Columns(colAlfa).Hidden = False
                Else
                    Columns(colAlfa).Hidden = True
                End If
            End If
        Next i
    End With
    Unload UserForm1
End Sub

'=================================================
'クリア処理
'=================================================
Private Sub CommandButton2_Click()
    Dim colAlfa As String

    For i = 1 To Columns.Count
        nowcol = Cells(1, i).Address(True, False)
        colAlfa = Left(nowcol, InStr(nowcol, "$") - 1)
        Columns(colAlfa).Hidden = False
    Next i

    Unload UserForm1

End Sub
'=================================================
'初期化処理
'=================================================
Private Sub UserForm_Initialize()
    '選択行
    rowno = ActiveCell.Row
    '初期カラム
    colno = ActiveCell.Column + 1

    'リスト作成
    For i = colno To Columns.Count
        If UserForm1.ListBox1.ListCount = 0 Then
            UserForm1.ListBox1.AddItem Cells(rowno, i).Value
        Else
            flg = False
            For j = 0 To UserForm1.ListBox1.ListCount - 1
                If Cells(rowno, i).Value = UserForm1.ListBox1.List(j) Then
                    flg = True
                    Exit For
                End If
            Next
            If flg = False Then UserForm1.ListBox1.AddItem Cells(rowno, i).Value
        End If
    Next i

End Sub