VBAのフィルター操作

下記のコードはArrayが２つですが、Arrayの部分に別シートのＣ１からＣ３０セルを参照したい場合
どのようなコードにすればいいですか？

またそのようにした場合
ActiveSheet.Range("A2").AutoFilter Field:=6, Criteria1:= _
"*" & Target_Word(0) & "*", _
Operator:=xlOr, Criteria2:="*" & Target_Word(1) & "*"
の部分はどのように変更すればいいですか？

Sub オートフィルタで複数条件を含むリスト抽出()

Dim Target_Word() As Variant

Target_Word = Array("川", "福")

ActiveSheet.Range("A2").AutoFilter Field:=6, Criteria1:= _
"*" & Target_Word(0) & "*", _
Operator:=xlOr, Criteria2:="*" & Target_Word(1) & "*"

End Sub

質問者からの補足コメント

• 

  ありがとうございます。
  
  教えて頂いたAdvancedFilter を使用し、ググってみたり、例のコードを改良して
  コードを実行してみたのですがうまくいきません。
  
  例のコード見たいなものをご提示頂く事はできますでしょうか？

  No.1の回答に寄せられた補足コメントです。 補足日時：2023/08/08 15:17

No.4 ベストアンサー 回答者： fujillin 回答日時： 2023/08/08 21:46

No3です。

たびたび申し訳ない。（また、やってしまった）
No3は破棄してください。以下に入れ替えてください。

Sub Sample()
Dim cRange As Range
Dim c As Long, r As Long
Dim fTitle As String, v
fTitle = "@" & Chr(27) & "@"

Const conditionRange = "Sheet2!C1:C5" ' 条件文字群範囲
Const filterRange = "Sheet1!F1:F20" ' フィルター対象範囲（キー列）

With Range(filterRange).Worksheet
c = .UsedRange.SpecialCells(xlCellTypeLastCell).Column + 1
For r = 1 To Range(conditionRange).Rows.Count
.Cells(r + 1, c).Value = "*" & Range(conditionRange).Cells(r, 1).Value & "*"
Next r
Set cRange = .Cells(1, c).Resize(r)
End With

With Range(filterRange)
.AutoFilter
v = .Cells(1, 1).Value
If .Cells(1, 1).HasFormula Then v = .Cells(1, 1).Formula
cRange.Cells(1, 1).Value = fTitle
.Cells(1, 1) = fTitle
.AdvancedFilter xlFilterInPlace, cRange
.Cells(1, 1).Value = v
End With

cRange.EntireColumn.Delete
End Sub

No.5 回答者： ママチャリ 回答日時： 2023/08/11 15:38

ご質問の要件で、AdvancedFilter は、凝り過ぎでしょ！！

こんなので、十分なのでは・・・。

Sub オートフィルタで複数条件を含むリスト抽出()

Dim Target_Word() As Variant
Dim i As Long

Target_Word = WorksheetFunction.Transpose(Range("C1:C30"))
For i = 1 To UBound(Target_Word)
Target_Word(i) = "*" & Target_Word(i) & "*"
Next i

ActiveSheet.Range("A2").AutoFilter Field:=6, _
Criteria1:=Target_Word, Operator:=xlFilterValues

End Sub

No.3 回答者： fujillin 回答日時： 2023/08/08 19:04

No2です。

ちょっとミスりました。
（ActiveSheetへの処理が残って、混在してしまっていました。）
以下に、訂正してください。スミマセン。

Sub Sample()
Dim cRange As Range
Dim c As Long, r As Long
Dim fTitle As String, v
fTitle = "@" & Chr(27) & "@"

Const conditionRange = "Sheet2!C1:C5" ' 条件文字群範囲
Const filterRange = "Sheet1!F1:F20" ' フィルター対象範囲（キー列）

With Range(filterRange)
c = .Worksheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column + 1
For r = 1 To Range(conditionRange).Rows.Count
.Cells(r + 1, c).Value = "*" & Range(conditionRange).Cells(r, 1).Value & "*"
Next r
Set cRange = .Cells(1, c).Resize(r)

.AutoFilter
v = .Cells(1, 1).Value
If .Cells(1, 1).HasFormula Then v = .Cells(1, 1).Formula
cRange.Cells(1, 1).Value = fTitle
.Cells(1, 1) = fTitle
.AdvancedFilter xlFilterInPlace, cRange
.Cells(1, 1).Value = v
End With

cRange.EntireColumn.Delete
End Sub

No.2 回答者： fujillin 回答日時： 2023/08/08 17:05

No1です。

＞例のコード見たいなものをご提示頂く事はできますでしょうか？
条件がよくわからないので、以下は、勝手に想定した内容で作成したものです。

●セル範囲等は、とりあえず直接アドレスで指定する方式にしてあります。
●conditionRange は条件の語彙群があるセル範囲。
　必ず「含む」及びOrで抽出しますので、範囲内に空白セルがあると全てが抽出されます。
●filterRange は抽出対象のセル範囲。ただし、抽出対象列を指定してください。
（行の表示/非常時なので、比較対象列だけを指定しても、行全体が表示/非表示になります）
●フィルタオプションの場合、タイトル項目が必要になりますが、空白だったり重複していたりする可能性を考慮して、一時的に処理用のタイトルを設定し元に戻すといった処理などをしていますので、若干長い記述になっています。
●サンプルなので、指定範囲や対象シートのチェック等は一切行っていません。
（おかしな指定をすれば、エラーになる可能性があります）

Sub Sample()
Dim cRange As Range
Dim c As Long, r As Long
Dim fTitle As String, v
fTitle = "@" & Chr(27) & "@"

Const conditionRange = "Sheet2!C1:C5" ' 条件文字群範囲
Const filterRange = "Sheet1!F1:F20" ' フィルター対象範囲（キー列）

c = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column + 1
For r = 1 To Range(conditionRange).Rows.Count
Cells(r + 1, c).Value = "*" & Range(conditionRange).Cells(r, 1).Value & "*"
Next r
Set cRange = Cells(1, c).Resize(r)

With Range(filterRange)
.AutoFilter
v = .Cells(1, 1).Value
If .Cells(1, 1).HasFormula Then v = .Cells(1, 1).Formula
cRange.Cells(1, 1).Value = fTitle
.Cells(1, 1) = fTitle
.AdvancedFilter xlFilterInPlace, cRange
.Cells(1, 1).Value = v
End With

cRange.EntireColumn.Delete
End Sub

この回答へのお礼

ありがとうございます。頂いたコードをもとに、必要な部分は修正し、使えるようになりました。
本当にありがとうございました。

お礼日時：2023/08/08 17:45

No.1 回答者： fujillin 回答日時： 2023/08/08 12:02

こんにちは

単純にリストを並べるだけならば、Criteria1に配列をそのまま指定すれば数の制限はありませんけれど、ご提示の例の場合はワイルドカードで「含む」指定になっているので、手操作でいう所の「カスタムフィルター」に当たります。
残念ながら、こちらの場合は条件指定が2種類までしかできない仕様のようです。
Andのフィルターであれば、フィルター操作を繰り返すことでも可能ですが、Orの場合はそうもいきませんね。


・・ということで、ご質問内容を実現する方法として思いつく対応法を以下に。

1）エクセル機能のフィルターオプションを利用する
VBAで言えば AdvancedFilter を利用する方法です。
https://learn.microsoft.com/ja-jp/office/vba/api …
こちらであれば、Orで3つ以上の条件を指定することも可能です。
ただし、CriteriaRange はRangeオブジェクト以外を受け付けないようですので、配列を直接指定することはできません。
シート上のどこかの空き列に条件を作成する必要があります。
（不要であれば、フィルター後に削除することは可能です）

2）フィルター機能を利用せずに自前で実装する
普通に対象範囲内をループで処理する考え方です。
フィルターをかけたい範囲に対して、1行ずつ「条件に合うか否か」を判断し、その行を表示/非表示の処理をすることで、お望みのフィルターをかけた場合と同様の結果を得ることができるでしょう。
こちらであれば、全てメモリ内で処理できるので、一時的な空き列の利用のようなことはしなくても済みます。