MENU

【ノーコードVBA】部分一致でフィルターを実行(複数列可能)

エクセルVBAマクロを自動作成する無料アプリです。

例として「フィルターとドロップダウンリストを連動」させるVBAマクロを作成します。

事例 

 

アプリへのリンク

アプリへのリンク
 ⇒複数列フィルター(ドロップダウンリスト/部分一致)

 

アプリの画面

 

作成されたコード

アプリで作成したコードを、VBE画面に貼り付けて実行します。

 

 

ドロップダウンリストを選択するとフィルターが実行されました。

ドロップダウンリストをダブルクリックすると、フィルターが解除されます。

 

ポイント
作成されたコードは標準モジュールではなく、
   対象のシートのシートモジュールに貼り付けます

できました😊

 

VBAコードを見る

  '【重要】作成したコードは、標準モジュールではなく、対象のシートのシートモジュールに貼り付けます

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Intersect(Target, Range("a3:e3")) Is Nothing Then Exit Sub
    Application.EnableEvents = False
    Target.Select
    Call デモ_1(Target)
    Application.EnableEvents = True
End Sub


Sub デモ_1(Target As Range) '複数列フィルター(部分一致も可能)
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Dim currentColumn As Long
    currentColumn = Target.Column - Range("a3:e3").Cells(1, 1).Column + 1
    With Sheets("Sheet1").Range("a7")
            If isEmpty(Target.Value) Then
                .AutoFilter Field:=currentColumn
            ElseIf IsNumeric(Target.Value) Then
                .AutoFilter Field:=currentColumn, Criteria1:=Target
            ElseIf IsDate(Target.Value) Then
                .AutoFilter Field:=currentColumn, Criteria1:=Format(Target, Sheets("Sheet1").Cells(Range("a7").Row, Range("a7").Column + currentColumn - 1).NumberFormatLocal)
            Else
                .AutoFilter Field:=currentColumn, Criteria1:="*" & Target & "*"
            End If
    End With
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Intersect(Target, Range("a3:e3")) Is Nothing Then Exit Sub
    Target.Validation.Delete
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, Range("a3:e3")) Is Nothing Then
        Target.ClearContents
        Target.Validation.Delete
        Cancel = True
    End If
End Sub