AdvancedFilter 検索 複数条件

質問

AdvancedFilterを使って検索をしたいのですが、複数条件のVBAマクロの書き方を教えてください。

エクセル2010です。

2行目が見出し行で実際のデータは4行目から入っており、

T列を複数条件で検索をしたいのですが、

T4＝スカート 150サイズ,ズボン 120サイズ,Tシャツ 150サイズ
T5＝スカート,ズボン 150サイズ,
T6＝Tシャツ 150サイズ,スカート 120サイズ

1セルに対して、検索用文字列が数十種類入っている状態です。

これをUseFormを利用して複数条件で検索をしたいのですが、

テキストボックス1、テキストボックス2、コマンドボタン1

があるとして、

テキストボックス1にスカート
テキストボックス2に150

と入れて検索をかけたとき、T4のみが抽出結果に表示させたいです。

テキストボックス1にスカートのみで検索をかけると、T4-6が出るように表示させたいです。

テキストボックス1にTシャツ
テキストボックス2に150

T4とT6が出るようにしたい。

このような事は出来るのでしょうか？

Private Sub CommandButton2_Click()
Worksheets("マスタ").Activate
If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData
Range("BH1:BU4").ClearContents
Range("BH1:BU4").NumberFormatLocal = "@"

Range("BS2").Value = Range("T2").Value
Range("BS2").Value = Range("T2").Value

If Me.TextBox1.Value <> "" Then ' 種類
Range("BS3").Value = "*" & Me.TextBox1.Value & "*"
End If

If Me.TextBox2.Value <> "" Then ' サイズ
Range("BS4").Value = "*" & Me.TextBox2.Value & "*"
End If

If Cells(3, Columns.Count).End(xlToLeft).Column > 48 Then
Range("A2:AW" & Rows.Count).AdvancedFilter Action:=xlFilterInPlace, _
CriteriaRange:=Range("BH2").CurrentRegion, Unique:=False
End If
Range("BH1:BU4").ClearContents
Range("A1").Activate
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

これだと機能しないため、マクロを組める方、教えてほしいです。

オートフィルタだと、どうしてもフィルタボタンが出てしまい、見にくいので、

AdvancedFilterでやりたいのが希望です。

VBAわかる方、教えてください。

宜しくお願い致します。

回答No.9

cj_mover

＃２ー８、ｃｊです。＃８補足欄拝見しました。

> B列に変えたらいけました。ありがとうございます。

了解です。よかったです。

> T4＝あああ 20　いいい 20　ううう 90
> T5＝あああ 50
> T6＝おおお 20
>
> とあるとして、
>
> テキストボックス1に【あああ】
> テキストボックス2に【20】
>
> と入れた場合、T4のみが出てくるようにしたいのですが、
>
> 今のコードで試したところ、T4とT6が出てきてしまうのですが、

ご説明自体はよく解りますが、現象としては不可解です。
ご提示の条件で（最下行の基準をB列に変え）繰り返し動作確認しましたが、
何れも正常な結果を返すようです。
「何処に」＊５点　「何を」＊５点　という条件ひとつひとつについて、
もう一度確認してみて下さい。
併せて、
CommandButton2をクリックしているか、
Private Sub CommandButton2_Click()の（実際の）記述が具体的にどうなっているか、
書換えた部分があるなら、その部分に注目するように再チェックしてみてください。
また、今回、Ｂ列の最下行を基準にするということですから、
記述の書換え（Ｂ列）が適用されていること、
実際のＢ列の最下行が６行めより下にあること、
を、（各試行ごとに変えることなく）確かめてください。
私が提示した１）２）３）については、何れも、
ご説明通りの条件でテストすると、ご指摘のような不正処理を再現出来ません。
何か他の（説明にない）条件が原因と思えるぐらい、普通は起こり得ない現象です。
現在知り得る限りでは、「1+1は2です」「よね？」的に不思議な心持ちです。
とりあえず、確認して貰って、それでも活路を見いだせない場合は、
実際の"今のコード"を提示してみてください。
実際のコードが私の期待する通りのものであるのに、
間違いなく、不正な結果を出すのでしたら、
その場合は、いよいよ実物ファイルをアップして貰って見てみないと解らないかも知れません。
少なくとも今の私には、それ以外考えられません。

ところで、
先回までのやり取りの中で色々新しく解ってきたことを踏まえて、
私が提示したものの中では、Excel数式を使うタイプの２）をお奨めしたいと考えていましたが、
２）や３）は、（各[車種][型番]の組合せが）カンマで区切られている前提で書いていますので、
例えば、（テキストボックス1に【あああ】テキストボックス2に【20】は共通）
　T4＝あああ 20,いいい 20,ううう 90
　T5＝あああ 50,いいい 20
　T6＝おおお 20
というサンプルでは、正しくT4だけを抽出しますが、
　T4＝あああ 20　いいい 20　ううう 90
　T5＝あああ 50　いいい 20
　T6＝おおお 20
というサンプルでは、T4,T5を抽出し、不正に終ります。
（今、問題にしているサンプルの場合は、偶々、どれも正しい結果を返す筈ですが、、、。）
前提が変わったのか、前提が間違っていたのか、今回の説明が違うのか、どれかだと思いますが、
区切り文字を変えるってことは、対象の文字列も変われば、抽出条件も変わる、ということです。
この点も、よく確認した上で、あなたが求める仕様について、
未だに言い表せていない要求仕様があるなら、少し整理する時間が必要かも知れませんね。
最終的にどんな仕様にするか、については、こちらで決められるものではないですから、、、。
一般論として、ですが、Ｑ＆Ａの質疑で途中で前提が変わる、というのは好ましいことではありません。
私自身も、もう少し察しが良ければ、という点もあるのかも知れませんが、
こういう場所では、書いてあること、だけが頼りです。

ベストな結果が得られるように、したいですね。

補足

申し訳ございませんでした。

T列の書き方は（,）で区切られておりません。。

,で区切らないと結果が出ないのであれば、全て、,で区切るように作ります。

あああ 20,いいい 20,ううう 90

と言うことですよね？

すいません、,で区切っていると言ったつもりはなかったのですが、説明不足でした。

ただただ、T列に、文字が入っているだけのような形です。

下記コードです。

Private Sub CommandButton1_Click()
Dim sCriteria_1 As String '　抽出条件「品目」
Dim sCriteria_2 As String '　抽出条件「品目
Dim sCriteria_W As String '　抽出条件文字列
Dim nBottomRow As Long '　Ｔ列を基準に最下行を取得

' ' 抽出条件「品目」を取得
sCriteria_1 = TextBox1.Value

' ' 抽出条件「品目」が空なら、メッセージを表示して、処理終了
If sCriteria_1 = "" Then
MsgBox "車種を入力してください！"
Exit Sub
End If

' ' 抽出条件「サイズ」を取得
sCriteria_2 = TextBox2.Value

' ' 対象シートについて、選択、フィルター抽出状態ならばキャンセル
With Worksheets("商品マスタ")
.Select
If .FilterMode Then .ShowAllData
End With

' ' Ｔ列を基準に最下行を取得
' ' Ａ列を基準に最下行を取得
nBottomRow = Cells(Rows.Count, "B").End(xlUp).Row

If sCriteria_2 = "" Then
' ' 抽出条件文字列を作成
sCriteria_W = "*" & sCriteria_1 & "*"
' ' 抽出条件項目名を設定
Cells(nBottomRow + 1, "T").Value = Cells(2, "T").Value
Else
' ' 抽出条件数式文字列を作成
sCriteria_W = "=FIND(""" & sCriteria_2 & """,T3,FIND(""" & sCriteria_1 & _
""",T3))<FIND("","",T3&"","",FIND(""" & sCriteria_1 & """,T3))"
' ' 抽出条件項目名は設定しない
End If

' ' 実際に使用する抽出条件
Cells(nBottomRow + 2, "T").Formula = sCriteria_W

' ' フィルタオプションの実行
Range("A2:AW" & nBottomRow).AdvancedFilter _
Action:=xlFilterInPlace, _
CriteriaRange:=Cells(nBottomRow + 1, "T").Resize(2), _
Unique:=False

' ' 抽出条件をクリア
Cells(nBottomRow + 1, "T").Resize(2).ClearContents

' ' 以下、元コードのまま
Range("A1").Activate

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

回答No.8

cj_mover

＃２ー７、ｃｊです。＃７補足欄拝見しました。

事情が呑み込めました。
そういうことでしたら、
私が提示したコードを実際の運用に合わせる修正として、
>>　　' ' Ｔ列を基準に最下行を取得
>>　　nBottomRow = Cells(Rows.Count, "T").End(xlUp).Row
この記述でＴ列の最下行を取得しているのを、替えて、
"4行目から512行目"のデータで、空白のない列、の最下行を取得を取得するようにします。
例えば、Ａ列ならば、"4行目から512行目"の範囲で空白セルが無い、という条件が確認できるなら、
　　' ' Ａ列を基準に最下行を取得
　　nBottomRow = Cells(Rows.Count, "A").End(xlUp).Row
のように書換えてください。（　私が提示した１）２）３）に共通の対策です。）
"T"→"A"のように、列名を１カ所だけ書き換えます。

Ｔ列の空白までもが抽出されてしまう、のではなく、
抽出範囲"4行目から496行目"から漏れた"497行目から512行目"がそのまま表示されている、
というのが現状のようです。

以上は、ひとつの、明確（クリア）な解決に結びつくものと思います。
まだ問題があるようでしたら、遠慮なくどうぞ。

とりあえず、以上です。

補足

B列に変えたらいけました。ありがとうございます。

' ' Ａ列を基準に最下行を取得
　　nBottomRow = Cells(Rows.Count, "B").End(xlUp).Row

一つ解決しました。ありがとうございます。

検索して結果が異なるものが出てくるのですが、
T列に、

T4＝あああ 20　いいい 20　ううう 90
T5＝あああ 50
T6＝おおお 20

とあるとして、

テキストボックス1に【あああ】
テキストボックス2に【20】

と入れた場合、T4のみが出てくるようにしたいのですが、

今のコードで試したところ、T4とT6が出てきてしまうのですが、

T4のみ出てくるようにすることは出来るのでしょうか？

ちなみに、テキストボックス1に【あああ 20】

と入れれば、T4のみ出てくるのですが、

それをテキストボックス1とテキストボックス2を使って出来るようになればベストなのですが、

説明わかりますでしょうか＞＜

回答No.7

cj_mover

＃２ー６、ｃｊです。＃６補足欄拝見しました。

> 型番に*はないですが、#があるものもあります。。
あーなるほど。
Like演算子を使った３）は、そのままでは対応できませんね。
マッチングパターンに含まれる"#"を"[#]"に換えてあげるような対応が必要です。
しかし、１）２）に関しては"#"の問題は関係ないようですから、
未だ、クリアな解決には至らないですね。

> データを一度みて、出来るのか出来ないのかを見て頂く事は可能でしょうか？
＃"出来るのか出来ないのか"というより、如何に最適化していくか運用上のご相談、
＃ということになるかと思いますが、、、。
個人的には構いません。
OKWaveの利用規約やガイドライン（主に個人情報や著作権に関して）に準ずる形で、
アップロードされたファイル（一度アップしたらクラウド側での編集・書き換えができないもの）
を見て、対応を検討すること、求める結果が得られるよう導くこと、までなら、
お付き合いします。（利用規約に反することは出来ません。）

ところで、
>> おそらくは、正しく抽出できている時と、不正に空白セルを抽出してしまう時、
>> に分かれているのでしょうから、
この部分はハッキリしませんか？
「"毎度毎度、必ず"、空白セルを抽出してしまう」のかどうか、だけでも、お答えいただきたいです。

取り急ぎ。

補足

「"毎度毎度、必ず"、空白セルを抽出してしまう」

形です。

ただ、出てきてしまう、行は毎回同じで、497行から512行です。

どのような形で検索をしてもこの16行が必ず抽出されてしまいます。

T列は全て空白の行です。

実際のデータは4行目から512行目まで今の所データがあります。

回答No.6

cj_mover

＃２ー５、ｃｊです。＃５補足欄拝見しました。

> 質問なのですが、１、２について、
> T列の空白部分も引っかかってきていたのですが、出てしまうのでしょうか？

問題点がハッキリと把握できていないので、うまくリード出来そうもありませんが、すみません。
抽出後のデータについて、Ｔ列が空白セルのものまで抽出されてしまう、ということでしょうか？
そういう結果が出ることは無いように書いたつもりですし、
サンプルデータを書き換えて色々テストしてみましたが、こちらが想像できる範囲では、
ご指摘のような不正な結果を再現することが出来ませんでした。
しかし考えられる可能性として、例えば、
おそらくは、正しく抽出できている時と、不正に空白セルを抽出してしまう時、
に分かれているのでしょうから、
不正な結果に終った時の、抽出条件について、
各テキストボックスでの指定値と、その場合に抽出されるべき文字列とを、
確認してみた方がいいかもです。
回答No.４でも触れたように（部分的にはLike演算子についての説明ですが、、、）、
>> また、データに特定の文字?*#{}!を含む場合は、正しい結果が得られないか、エラーになります。
>> こういうのは、文字列をフィルターに掛ける時には必ず付いてまわる条件ですから、
>> 実データの在り方や運用の在り方等勘案して、必要に合わせた書き方をする、
ということなので、
抽出に必要なメタ文字（抽出機能に関連付けられる特別な文字記号）を含むような文字列を、
抽出条件や検索対象の文字列に含むような場合は、
それらをエスケープ（無効化する処理）してあげないとなりません。
具体的な例でいえば、
「20*2014」みたいな型番を検索するような4ことがあるならば、
"*"アスタリスクはメタ文字（ワイルドカード）ですから、そのままでは正しい抽出は出来ません。
「20*2014」を「20~*2014」のように文字列としての"*"であることを指定してあげれば、
正しい抽出結果が得られるようになります。
こういった視点で考えてみても、ご指摘のような不正結果を再現することが出来ていませんので、
不確かですが、不正に空白セルを抽出してしまう時、の状況を確認することから始めて、
ケースバイケースで対応を考えるしかないように思います。

もしかして、、、、（こういう意味なのかな？と読めなくもないので一応）
Ｔ列が空白の場合、でも、抽出結果として表示させたい、とか、、、
最初から空白セルということになっているＴ３セルも、抽出結果として表示させたい、とか、
そういう意味でしたらば、一般的なフィルター機能に対しては、
オプションとしての特殊な対応になりますから、具体的な要求仕様が出てからの対応になります。

> 全て試させて頂きました。３は検索しても結果が出なかった...
これも、こちらでは、不正な結果を出す方法が思い当たりませんでした。
つまり、こちらが想定しているデータの在り方や抽出条件の指定の仕方などが、
そちらでの実際とは違う点がある、ということはハッキリしていますから、
原因が掴めていない以上は、動作の確認や検証については、厳しめにしておいた方がいいかも、です。

スッキリしないかも知れませんが、今の処、ここまでです。

補足

ありがとうございます。

抽出後のデータについて、Ｔ列が空白セルのものまで抽出されてしまう、ということでしょうか？

その通りです、
抽出結果にT列が空白のものが出てきてしまいます。

型番に*はないですが、#があるものもあります。。

データを一度みて、出来るのか出来ないのかを見て頂く事は可能でしょうか？

もしそこまでは出来ないと言うことであれば、それは無料で教えて頂いていることなので、断ってください。

回答No.5

cj_mover

＃２ー４、ｃｊです。＃４補足欄拝見しました。

すみません、私は車知らないので、ご説明の前提になっているであろうそちらの常識的な部分が
理解できないままでいます。
> プリウス、
> かつ20を含むが良いのですが、

> この場合書いて頂いた中で、何番があてはまりますか？

"プリウス"と"20"を抽出条件とした場合、
　プリウス 15,ヨタハチ 20
のようなセルをヒットさせたいのなら、その説明で十分ですけれど、
当初の例示からすると、これはヒットしない方がいいのですよね？
そういう意味では、どれでもいいように書いたつもりです。
実データ見ないと何とも言えないので、どれか選べるように複数提示しました。
どれがいいのかは実ファイルで試して検証して貰わないと、こちらから判断できる程の情報がありません。
どれから試せばいいか、という意味でしたら、２）あたりをどうぞ。

さしあたり、返答まで。

補足

全て試させて頂きました。３は検索しても結果が出なかったので、３は省いて、１、２についてはきちんと結果が出ました！！
感動してしまいました。
ありがとうございます。

質問なのですが、１、２について、
T列の空白部分も引っかかってきていたのですが、T列が空白の場合、出てしまうのでしょうか？

回答No.4

cj_mover

（３／３）前の投稿の続きです。

◆３）
差し当たり、ＶＢＡ初級のマッチングとしてLike演算子を使ってみます。
（簡単な例としてLike演算子を使いますが、
　InStr(),InStrRev()関数を組合わせて使えば、少し難しいけど、精度はやや上。）
メモリ上で、カンマ区切りに切り分け、個々の文字列について、
　　*「品目」*「サイズ」*
に該当するものが見つかれば、作業列にフラグを吐いておいて、
作業列にてフィルターを掛けて抽出します。
１）と比べると、「品目」の後（カンマの前）に「サイズ」があれば、
その間が[半角スペース*1]でなくてもどんな文字列でもマッチします。
ただ、１）３）共通の難点ですが、
例えば、「品目」"スカート"で抽出する場合"ミニスカート"もマッチしますし、
例えば、「サイズ」"15"で抽出する場合"150","1500","115"もマッチします。
この点は、１セル１データ、でない以上、分別するのに
詳細なサンプルと比較的高度な技術とが必要になります。
全角・半角を区別しないように、モジュールの先頭でOption Compare Textを宣言します。
代償としてアルファベットの大文字・小文字の区別もできなくなります。
また、データに特定の文字?*#{}!を含む場合は、正しい結果が得られないか、エラーになります。
こういうのは、文字列をフィルターに掛ける時には必ず付いてまわる条件ですから、
実データの在り方や運用の在り方等勘案して、必要に合わせた書き方をする、
ということになります。
その意味では、他人任せでは、ナカナカ思い通りのものに辿り着けないのかも知れません。
これより精度を高める必要があれば、VBSの正規表現を勉強するとか、
案外、Excelの数式（関数）を応用することで対応できる場合もあるかも知れません。
「検索（パターンマッチング）」と「抽出」の２段階に分けて処理する、
ということで、簡単なサンプルです。
（作業セルを仮にＢＳ列にして書いてあります。変更は BS を置換。）
///
Option Compare Text　'　←　必ず、モジュールの先頭に記述。

Private Sub CommandButton2_Click()
　　Dim v
　　Dim c As Range
　　Dim sCriteria_1 As String　'　抽出条件「品目」
　　Dim sCriteria_2 As String　'　抽出条件「品目
　　Dim sCriteria_W As String　'　抽出条件文字列
　　Dim nBottomRow As Long　'　Ｔ列を基準に最下行を取得

　　' ' 抽出条件「品目」を取得
　　sCriteria_1 = TextBox1.Value

　　' ' 抽出条件「品目」が空なら、メッセージを表示して、処理終了
　　If sCriteria_1 = "" Then
　　　　MsgBox "品目を入力して！"
　　　　Exit Sub
　　End If

　　' ' 抽出条件「サイズ」を取得
　　sCriteria_2 = TextBox2.Value

　　' ' 対象シートについて、選択、フィルター抽出状態ならばキャンセル
　　With Worksheets("マスタ")
　　　　.Select
　　　　If .FilterMode Then .ShowAllData
　　End With

　　' ' 抽出条件文字列を作成
　　If sCriteria_2 = "" Then
　　　　sCriteria_W = "*" & sCriteria_1 & "*"
　　Else
　　　　sCriteria_W = "*" & sCriteria_1 & "*" & sCriteria_2 & "*"
'　　　　sCriteria_W = "*" & sCriteria_1 & "*" & sCriteria_2 & "サイズ*"
　　End If

　　' ' Ｔ列を基準に最下行を取得
　　nBottomRow = Cells(Rows.Count, "T").End(xlUp).Row

　　' ' 作業列の値を（必要なら）消去
　　With Range("BS4:BS" & nBottomRow)
　　　　If Application.Count(.Cells) Then .ClearContents
　　End With

　　' ' Ｔ列のデータ範囲をループ
　　For Each c In Range("T4:T" & nBottomRow)
　　　　' ' 個々のデータをカンマ区切りで切り分けた文字列をマッチング
　　　　For Each v In Split(c.Value, ",")
　　　　　　' ' マッチすれば、作業列の同じ行のセル値を 1 に
　　　　　　If v Like sCriteria_W Then
　　　　　　　　Cells(c.Row, "BS").Value = 1
　　　　　　　　Exit For
　　　　　　End If
　　　　Next
　　Next

　　' ' 作業列を基準にオートフィルター（ボタン非表示）
　　Range("BS2:BS" & nBottomRow).AutoFilter _
　　　　Field:=1, _
　　　　Criteria1:=1, _
　　　　VisibleDropDown:=False

　　' ' 作業列の値を消去
　　Range("BS4:BS" & nBottomRow).ClearContents

　　' ' 以下、元コードのまま
　　Range("A1").Activate

　　Application.Calculation = xlCalculationAutomatic
　　Application.ScreenUpdating = True

End Sub
///

◆４）
端的にいえば、現在のデータの在り方が、Excelが得意とするデータの在り方ではない、ということです。
この特殊な事情が理由で、簡単に結論を導くことが難しくなっているようですし、、
この回答がこれほどの長文になってしまう所以でもあります。
因みに、ワークシートメニューの[データ][区切り文字]でカンマ区切りを指定すれば、
データを列方向に展開することが可能ですが、この機能は１セル１データを確保する為に用意されたものです。
しかしまあ、１）で挙げた条件のように、データの入力フォーマットが、
ルール上でも運用上でも堅いものであるならば、現状のままでもある程度の対応は可能かと思います。
ただ、今後もExcelで新しい分析機能を追加していくということであれば、
やはり全体の設計を見直した方が苦労が少ないようにも思います。
でも、実物を、経験のある人が見て、という条件でないと、設計を変えるにも方向が定まらないと思います。
環境が許すなら外注するのが早いでしょうけれど、それが難しいようでしたら、
ひとつひとつ確かめながら工夫していくことになるのでしょう。
その際、求める仕様、をハッキリさせ、使うツールの仕様、を確認して（理解を深め）、
繰り返し相互にフィードバックしながらより確かなアプローチを見つけて行く、ことが大事です。
今回の例でいえば、実際に手を動かしてフィルターオプションを知る、ということからでしょうか。
１）のサンプルでも良さそうだったら検証を踏まえて確実なものにするとか、
３）のサンプルを元にLike演算子に出来ることできないことを確認しておくとか、
正規表現を覚えるとか、、、。

＃"複数条件"の意味が３つ以上の抽出条件、という話だったりする？場合も
＃上記の応用で可能な場合が殆どだと思いますが、うまく行かない場合は、
＃適当な例示を添えて再度質問を建て直した方が解決は近いと思います。

（３／３）
以上、ご参考まで。長、失礼しました。

補足

色々教えて頂いてありがとうございます。

データは一つのセルに、30種類くらい入っているものもあり、

実際のデータは、車種一覧です。

車種例えば(プリウス)半角スペース型番(20系)

車種は、全角で型番は半角です。

その間のスペースは、半角にしてます。

オートフィルターで検索をした場合、きちんと
結果がでるのは、(プリウス￠20)

です。

あいまい検索ですると、20が含む行が全てでてしまうので、

プリウス、
かつ20を含むが良いのですが、

この場合書いて頂いた中で、何番があてはまりますか？

回答No.3

cj_mover

（２／３）前の投稿の続きです。

◆２）
抽出条件がひとつなら、
　項目名
　*スカート*
のように１列２行、で文字列値を指定、
　　　　（空セル）
　=FIND("150",T3,FIND("スカート",T3))<FIND(",",T3&",",FIND("スカート",T3))
のように１列２行で数式を抽出条件に指定します。
///
Private Sub CommandButton2_Click()
　　Dim sCriteria_1 As String　'　抽出条件「品目」
　　Dim sCriteria_2 As String　'　抽出条件「品目
　　Dim sCriteria_W As String　'　抽出条件文字列
　　Dim nBottomRow As Long　'　Ｔ列を基準に最下行を取得

　　' ' 抽出条件「品目」を取得
　　sCriteria_1 = TextBox1.Value

　　' ' 抽出条件「品目」が空なら、メッセージを表示して、処理終了
　　If sCriteria_1 = "" Then
　　　　MsgBox "品目を入力して！"
　　　　Exit Sub
　　End If

　　' ' 抽出条件「サイズ」を取得
　　sCriteria_2 = TextBox2.Value

　　' ' 対象シートについて、選択、フィルター抽出状態ならばキャンセル
　　With Worksheets("マスタ")
　　　　.Select
　　　　If .FilterMode Then .ShowAllData
　　End With

　　' ' Ｔ列を基準に最下行を取得
　　nBottomRow = Cells(Rows.Count, "T").End(xlUp).Row

　　If sCriteria_2 = "" Then
　　　　' ' 抽出条件文字列を作成
　　　　sCriteria_W = "*" & sCriteria_1 & "*"
　　　　' ' 抽出条件項目名を設定
　　　　Cells(nBottomRow + 1, "T").Value = Cells(2, "T").Value
　　Else
　　　　' ' 抽出条件数式文字列を作成
　　　　sCriteria_W = "=FIND(""" & sCriteria_2 & """,T3,FIND(""" & sCriteria_1 & _
　　　　　　　　　　""",T3))<FIND("","",T3&"","",FIND(""" & sCriteria_1 & """,T3))"
　　　　' ' 抽出条件項目名は設定しない
　　End If

　　' ' 実際に使用する抽出条件
　　Cells(nBottomRow + 2, "T").Formula = sCriteria_W

　　' ' フィルタオプションの実行
　　Range("A2:AW" & nBottomRow).AdvancedFilter _
　　　　Action:=xlFilterInPlace, _
　　　　CriteriaRange:=Cells(nBottomRow + 1, "T").Resize(2), _
　　　　Unique:=False

　　' ' 抽出条件をクリア
　　Cells(nBottomRow + 1, "T").Resize(2).ClearContents

　　' ' 以下、元コードのまま
　　Range("A1").Activate

　　Application.Calculation = xlCalculationAutomatic
　　Application.ScreenUpdating = True

End Sub
///

（２／３）
次の投稿に続きます。

回答No.2

cj_mover

（１／３）
こんにちは。お邪魔します。
（長くなったので３回に分けます。連投失礼。）
＃書いたり確認したりで時間が掛かかりましたが、せっかく書いたので投稿します。

◆
ひとまず、
> オートフィルタだと、どうしてもフィルタボタンが出てしまい、見にくいので、
>
> AdvancedFilterでやりたいのが希望です。
この点については、
Range.AutoFilter メソッド を使って、名前付き引数 VisibleDropDown を指定してあげれば、
"フィルタボタン"を非表示にしてオートフィルタを掛けられますから、
ここに書かれた理由だけで、AdvancedFilter でなければならない、ということではないです。
ひとつのフィールドに対する抽出条件が２つまでなら、ですけれど、２つまでのようなので、、、
以下、AutoFilter メソッドのサンプル。
///
Sub Re8700373a()

　　With Worksheets("マスタ")
　　　　.Select
　　　　' ' オートフィルタ設定の解除（フィルタが掛かっているかどうではなく、オートフィルタそのもの）
　　　　If .AutoFilterMode Then .AutoFilterMode = False
　　End With

　　Range("T2:T100").AutoFilter _
　　　　Field:=1, _
　　　　Criteria1:="*スカート*", _
　　　　Criteria2:="*150*", _
　　　　Operator:=xlAnd, _
　　　　VisibleDropDown:=False

End Sub
///

◆
ところで、
「やりたい事、求める結果」と、アプローチの仕方が合っていないような気がするので、
確認してみてください。
> 2行目が見出し行で実際のデータは4行目から入っており、
<中略>
> T4＝スカート 150サイズ,ズボン 120サイズ,Tシャツ 150サイズ
> T5＝スカート,ズボン 150サイズ,
> T6＝Tシャツ 150サイズ,スカート 120サイズ
というデータと配置が正確だったとして、
> テキストボックス1にスカート
> テキストボックス2に150
>
> と入れて検索をかけたとき、T4のみが抽出結果に表示させたいです。
まず前提として、And条件（"スカート"を含む、且、"150"を含む）で抽出するには、
　項目名　　　　　項目名
　*スカート*　　*150*
のように２列２行の条件範囲を指定する必要があります。
　項目名
　*スカート*
　*150*
のように１列３行で指定した場合は、Or条件ですから、
"スカート"を含む、または、"150"を含む、、、になってしまいます。
それよりも、
フィルターで文字列データを扱う以上は、「～を含む」という抽出しか出来ませんから、
抽出条件　　"*スカート*"　And　"*150*"
を正しく指定した場合でも抽出結果は、T4,T5,T6 になってしまいます。
（サンプルデータのすべてが、"スカート"と"150"の両方を含むからです。）
これは、ＶＢＡがどうこういう問題ではなくて、
Excelの一般機能で用意されているフィルターオプション（やオートフィルタ、ピボットテーブル）
の仕様（というより、そもそものフィルターの目的）が、そういうものだからです。
手作業にてフィルターオプション（フィルター/詳細設定）を動かしてみて、
「やりたい事、求める結果」に対して適切なツールであるかどうか、を確認してみてください。
以下、質問文で説明された通りの求める結果、を得る方法について書きます。
目的を達成する為の、アプローチを３通り。
　１）抽出条件を、"*スカート 150サイズ*" または "*スカート 150*" のように替え、
　　　フィルターオプションまたはオートフィルターで抽出する。
　２）抽出条件にExcelの数式を指定する。
　３）「検索（パターンマッチング）」と「抽出」の２段階に分けて処理する。
　４）Excelのフィルターが必要とする条件に合わせて、現在のデータを
　　　データベース（テーブル）としての要件を満たすよう、１セル１データ、１列１項目、
　　　へと書き直す。自ずとファイル全体の設計を大幅に変更する。
ＶＢＡで、ということだと、一番現実的なのは、３）のように思います。
実際のファイルを見れば、こちらも判断つきますが、
都合よく（理想的に）条件が合えば、１）の方法が一番簡単です。
とりあえず、、、

◆１）
ご提示のサンプルデータは、
　　「品目」半角スペース*1「サイズ」（カンマ）
個々のデータをカンマで区切り、
「品目」と「サイズ」の間を半角スペース*1で区切ってあります。
この書式に合う形のデータであれば、、、一連の文字列として抽出可能です。
　項目名
　*スカート 150*
のように１列２行で抽出条件を指定します。
ただ、ご提示のサンプルデータは、すべての文字が全角・半角どちらでも表せる文字ですから、
もしも、このデータが手入力されたものであれば、"Ｔシャツ"と"Tシャツ"、
のような（ありがちな）混在まで意識する必要が出てくるので、
その場合は、フィルターを使うこと自体、難し過ぎますから、諦めた方がいいのかも知れません。
以上の説明のように、条件がかなり厳しいですが、サンプルコードです。
///
Private Sub CommandButton2_Click()
　　Dim sCriteria_1 As String　'　抽出条件「品目」
　　Dim sCriteria_2 As String　'　抽出条件「サイズ」
　　Dim sCriteria_W As String　'　抽出条件文字列
　　Dim nBottomRow As Long　'　Ｔ列を基準に最下行を取得

　　' ' 抽出条件「品目」を取得
　　sCriteria_1 = TextBox1.Value

　　' ' TextBox1が空なら、メッセージを表示して、処理終了
　　If sCriteria_1 = "" Then
　　　　MsgBox "抽出条件を入力！"
　　　　Exit Sub
　　End If

　　' ' 抽出条件「サイズ」を取得
　　sCriteria_2 = TextBox2.Value

　　' ' 対象シートについて、選択、フィルター抽出状態ならばキャンセル
　　With Worksheets("マスタ")
　　　　.Select
　　　　If .FilterMode Then .ShowAllData
　　End With

　　' ' 抽出条件文字列を作成
　　If sCriteria_2 = "" Then
　　　　sCriteria_W = "*" & sCriteria_1 & "*"
　　Else
　　　　sCriteria_W = "*" & sCriteria_1 & " " & sCriteria_2 & "*"
'　　　　sCriteria_W = "*" & sCriteria_1 & " " & sCriteria_2 & "サイズ*"
　　End If

　　' ' Ｔ列を基準に最下行を取得
　　nBottomRow = Cells(Rows.Count, "T").End(xlUp).Row

　　' ' 実際に使用する抽出条件
　　Cells(nBottomRow + 1, "T").Value = Cells(2, "T").Value
　　Cells(nBottomRow + 2, "T").Value = sCriteria_W

　　' ' フィルタオプションの実行
　　Range("A2:AW" & nBottomRow).AdvancedFilter _
　　　　Action:=xlFilterInPlace, _
　　　　CriteriaRange:=Cells(nBottomRow + 1, "T").Resize(2), _
　　　　Unique:=False

　　' ' 抽出条件をクリア
　　Cells(nBottomRow + 1, "T").Resize(2).ClearContents

　　' ' 以下、元コードのまま
　　Range("A1").Activate

　　Application.Calculation = xlCalculationAutomatic
　　Application.ScreenUpdating = True

End Sub
///

（１／３）
次の投稿に続きます。

回答No.1

eden3616

>オートフィルタだと、どうしてもフィルタボタンが出てしまい、見にくいので、
>AdvancedFilterでやりたいのが希望です。

AdvancedFilterではないですが・・・・セル非表示で。
テキストボックスを二つとも空欄にして実行で全て表示されます。

■VBAコード

Private Sub CommandButton1_Click()
'型宣言
Dim myArray() As String
Dim i As Long, j As Integer
Dim stRow As Long, trCol As String
Dim flag As Integer, word(1) As String
Dim ckword As Variant, ckmode As Integer

'設定
stRow = 4
trCol = "T"

'準備
ReDim myArray(0)
word(0) = "*" & Me.TextBox1.Value & "*"
word(1) = "*" & Me.TextBox2.Value & "*"
If word(0) <> "**" Then ckmode = ckmode + 1
If word(1) <> "**" Then ckmode = ckmode + 2

'処理
With ActiveSheet
　　'全表示
　　Cells.EntireRow.Hidden = False
　　If word(0) & word(1) = "****" Then Exit Sub
　　'各行に対して条件を判定
　　For i = stRow To .Cells(Rows.Count, trCol).End(xlUp).Row
　　　　flag = 0
　　　　For Each ckword In Split(.Cells(i, trCol), ",")
　　　　　　Select Case ckmode
　　　　　　Case 1
　　　　　　　　If ckword Like word(0) Then flag = 1
　　　　　　Case 2
　　　　　　　　If ckword Like word(1) Then flag = 1
　　　　　　Case 3
　　　　　　　　If ckword Like word(0) And ckword Like word(1) Then flag = 1
　　　　　　End Select
　　　　　　If flag Then Exit For
　　　　Next
　　　　'条件一致で非表示
　　　　If flag = 0 Then .Rows(i).Hidden = True
　　Next i
End With
End Sub