配列に基づく3つ以上の要素のオートフィルタ

Question

EDIT：私の変数にはワイルドカードが含まれています。ワイルドカードを使用している場合、オートフィルタには2つの条件しか含めることができないということがオンラインでわかりました。これは本当ですか？もしそうなら、これはおそらく私の問題です。残念です。 END EDIT

データにフィルタリングして、データに配列内の6つの項目のいずれかが含まれているかどうかを確認しようとしています。要素は文字列変数です。私の作業コードは：

With ActiveSheet 
    .Columns("J").AutoFilter Field:=1, Criteria1:=Array(d3, d2), _ 
    Operator:=xlFilterValues 
End With 

私が達成したいことのための作品です。しかし、実際には2つだけでなく、配列の6つの要素が必要です。残念ながら、6つの要素をすべて追加しようとすると、何も表示されません。

With ActiveSheet 
    .Columns("J").AutoFilter Field:=1, Criteria1:=Array(d3, d2, d1, d21, d11, d31), Operator:=xlFilterValues 
End With 

エラーは何も得られません。それは何も表示されないだけです。誰もこの問題を解決する方法を知っていますか？ 私は、文字列（d1、d21など...）のさまざまな組み合わせを使用して配列内の2つの要素だけを使ってコードをテストしましたが、それらはすべて意図したとおりに動作するため、変数に問題はありません。

Answer 1

オートフィルタは、ワイルドカードを有する2つの基準に制限されているが、バージョン1は、各基準に対して1つの別個のオートフィルタを適用し、連合範囲の可視行をキャプチャし、すべての行を非表示にし、ユニオン

---

Option Explicit 

Public Sub AutoFilterWithMultipleWildCardCriteria1() 

    Const CRIT = "*3 *5 *7 *9 *11" '= includes empty cells, <> non-empty cells 

    Dim wild As Variant, notWild As Variant, filtr As Range, i As Long 

    wild = Split(CRIT) 
    notWild = Split(Replace(Replace(CRIT, "*", vbNullString), "?", vbNullString)) 

    With Worksheets("Sheet1")       '<-- update your sheet name 
     Application.ScreenUpdating = False 
     .AutoFilterMode = False 

     With .UsedRange.Columns("J") 
      .Rows.Hidden = False 

      'capture first set (for criteria1 = *3) 
      .AutoFilter Field:=1, Criteria1:=wild(0), Operator:=xlOr, Criteria2:=notWild(0) 
      Set filtr = .SpecialCells(xlCellTypeVisible) 

      For i = 1 To UBound(wild)  'union the rest of the sets (*5 *7, etc) 
      .AutoFilter Field:=1, Criteria1:=wild(i), Operator:=xlOr, Criteria2:=notWild(i) 
      Set filtr = Union(filtr, .SpecialCells(xlCellTypeVisible)) 
      Next 

      Sheet1.AutoFilterMode = False 
      .Rows.Hidden = True 
      filtr.Rows.Hidden = False 
     End With 

     Application.ScreenUpdating = True 
     .Cells(1).Activate 
    End With 
End Sub 

を隠蔽を解除します

---

バージョン2は、辞書のキー配列に基づいて、最終的なフィルタを辞書内のすべての基準を満たすすべてのレコードをキャプチャし、適用

---

Public Sub AutoFilterWithMultipleWildCardCriteria2() 

    Const CRIT = "*3 *5 *7 *9 *11" '= includes empty cells, <> non-empty cells 

    Dim wild As Variant, notWild As Variant, filtr As Object 

    wild = Split(CRIT) 
    notWild = Split(Replace(Replace(CRIT, "*", vbNullString), "?", vbNullString)) 
    Set filtr = CreateObject("Scripting.Dictionary") 

    Application.ScreenUpdating = False 
    With Worksheets("Sheet1") 
     .AutoFilterMode = False 
     With .UsedRange.Columns("J") 
     If .Cells.CountLarge > 1 Then 
      Dim i As Long, itm As Variant 

      For i = 0 To UBound(wild) 
      .AutoFilter Field:=1, Criteria1:=wild(i), Operator:=xlOr, Criteria2:=notWild(i) 
      For Each itm In .SpecialCells(xlCellTypeVisible) 
       filtr(CStr(itm.Value2)) = 0 
      Next 
      Next 

      .AutoFilter Field:=1, Criteria1:=filtr.Keys, Operator:=xlFilterValues 
     End If 
     End With 
    End With 
    Application.ScreenUpdating = True 
End Sub