Excelで複数フィールド検索機能を作成する

Question

VBAでリンク検索機能を構築し、指定した検索フィールドにデータを入力した後に自動更新する必要があります。私は、コードの次のセクションで正常にこれを行うことができました：これはである - ： -

Sub FilterTo1Criteria() 
With Sheet3 
    If Range("A3") <> vbNullString Then 
     .AutoFilterMode = False 
     .Range("A6:J1015").AutoFilter 
     .Range("A6:J1015").AutoFilter Field:=1, Criteria1:=Range("A3") 
    Else 
     Selection.AutoFilter 
    End If 
End With 
End Sub 

シートの変更/自動更新

オートフィルタの検索標準モジュール内のコードが

ワークシートモジュール

コード：

Private Sub Worksheet_Change(ByVal Target As Range) 
    If Target.Address = "$A$3" Then 
     Application.EnableEvents = False 
     FilterTo1Criteria 
     Application.EnableEvents = True 
    End If 
End Sub 

しかし、ワットシート変更ページでは、条件としてセルA3：J3が必要ですが、A3とD3のみが入力されている場合、またはA3が入力されている場合（D3が空白の場合）、自動検索機能が動作する必要があります。 D3が埋め込まれていれば（A3は空白ですが）、この効果を得るためにコードを複合化する際に問題があります。どのくらい複雑にする必要がありますか？誰かが私がいくつかの情報を収集するために見ることができることを認識しているいくつかの例がありますか？何かを見つけるのは難しいです...

ピボットテーブルを備えたスライサーは、潜在的な方法ですが、下流の人々の中にはExcel 2003を使用していると思います。

ありがとうございます！

Answer 1

A3またはD3のいずれかが空でない場合に機能する関数については、2つのセルを連結してvbNullStringと比較することができます。

複数のフィルタでは、ループを使用してすべてのフィルタを設定できます。

例：

Sub FilterTo1Criteria() 
    Dim i As Long 
    With Sheet3 
    If Range("A3") & Range("D3") <> vbNullString Then 
      .AutoFilterMode = False 
      .Range("A6:J1015").AutoFilter 
      For i = 1 To 10 
       .Range("A6:J1015").AutoFilter Field:=i, Criteria1:=Cells(3, i) 
      Next i 
     Else 
      Selection.AutoFilter 
     End If 
    End With 
End Sub 

編集：

あなたが一度にすべての基準セルを充填したとして、フィルタを設定するのではなく、したいように見えます。代わりにこれを試してみてください：

Sub FilterTo1Criteria() 
    Dim i As Long 
    With Sheet3 
     .AutoFilterMode = False 
     .Range("A6:J1015").AutoFilter 
     For i = 1 To 10 
      If .Cells(3, i) <> vbNullString Then 
       .Range("A6:J1015").AutoFilter Field:=i, Criteria1:=.Cells(3, i) 
      End If 
     Next i 
    End With 
End Sub 

と新しいワークシートの変更サブ用：

Private Sub Worksheet_Change(ByVal Target As Range) 
    If Not Intersect(Target, Range("$A$3:$J$3")) Is Nothing Then 
     Application.EnableEvents = False 
     FilterTo1Criteria 
     Application.EnableEvents = True 
    End If 
End Sub 

あなたが基準（行3）を追加または削除するように、これは、フィルタを追加または削除します。