'アクティブセルの値でオートフィルタするマクロ

'1行目が項目見出しのリストで使用します。

'セルを1つ選択してInstantFilterマクロを実行してください。

Option Explicit

Sub InstantFilter()
    Const myTitle = "インスタントフィルタ"
    Dim range1 As Range

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

    If MsgBox("このツールはオートフィルタとウィンドウ枠固定をリセットします。", _
        vbOKCancel Or vbExclamation, myTitle) <> vbOK Then Exit Sub

    On Error GoTo err_1

    Application.ScreenUpdating = False
    Set range1 = ActiveCell
    Selection.CurrentRegion.Cells(2, 1).EntireRow.Select
    ActiveWindow.FreezePanes = False
    ActiveWindow.FreezePanes = True
    range1.Select
    Application.ScreenUpdating = True

    With Selection.CurrentRegion
        .AutoFilter
        .AutoFilter field:=ActiveCell.Column - .Column + 1, _
            criteria1:=">=" & ActiveCell.Value, operator:=xlAnd, _
            criteria2:="<=" & ActiveCell.Value
        ActiveWindow.ScrollRow = .Row
    End With
    Selection.Select
    Exit Sub
err_1:
    MsgBox Error(Err), vbExclamation, myTitle
    ActiveWindow.FreezePanes = False
    If ActiveSheet.AutoFilterMode Then ActiveSheet.Cells.AutoFilter
    Selection.Select
End Sub

Sub InstantFilterReset()
    Const myTitle = "インスタントフィルタ"
    If TypeName(Selection) <> "Range" Then Exit Sub
    If MsgBox("このツールはオートフィルタとウィンドウ枠固定をリセットします。", _
        vbOKCancel Or vbExclamation, myTitle) <> vbOK Then Exit Sub
    ActiveWindow.FreezePanes = False
    If ActiveSheet.AutoFilterMode Then ActiveSheet.Cells.AutoFilter
    Selection.Select
End Sub