オートフィルタオプションをVBAで指定したい

質問

表中に、このような列があるとします。

肩ロース100g
肩ロース500g
ヒレ100g
ヒレ250g
ヒレ500g
レバー100g
レバー250g

他の列には注文日や個数、小計金額があるとします。
オートフィルタをかけて、フィルタオプションで「○○で始まる」を指定し、例えばレバーの行のみを手作業で抽出することはできます。

この動作を、フィルタオプションでの設定を経由せずに行えないものでしょうか？
たとえば、別の列などに「肩ロース」「ヒレ」「レバー」が記載されていて、そのデータを元にオートフィルタの▼をクリックすると「肩ロース」「ヒレ」のように抽出条件データが表示される、というふうには出来ないものでしょうか？

ＶＢＡ等を使用しても構いません。
抽出項目は固定ですので、コード中に記述しても構いません。
動作が要望を満たせば、オートフィルタを使用しなくても構いません。
フォームウィンドウで抽出項目を指定し、その項目をCriteria等に設定してフィルタオプションでも構いません(この方法は自力で出来そうですが)。

良い方法があれば、お教え下さい。

回答No.1

Wendy02 · ベストアンサー

こんばんは。

フィルタオプションとして、フォームボタンなどに、以下を設定すればよいですね。
一応、トグルにしてありますから、フィルターモードの時に、クリックすれば、戻るようになっています。データ範囲やデータの位置は、ご自身で直してください。

なお、フォームボタンは、必ず、その[コントロールの書式設定]で、
◎セルにあわせて移動やサイズ変更をしない。
にチェックを入れてください。行がなくなったときに、このコントロールも見えなくなってしまいます。

後は工夫してみてください。

'<標準モジュール>
Sub FilterOption()
　　Dim myCriteria As Range
　　With ActiveSheet
　　'フィルタ・モードの時は、フィルタ・モードを戻す
　　If .FilterMode = True Then
　　　 .ShowAllData
　　Else
　　'Criteria は、I列。その下には何も書かない
　　Set myCriteria = .Range("I1", .Range("I65536").End(xlUp))
　　'データは、A1:A8 まで。
　　.Range("A1:A8").AdvancedFilter _
　　　　　　　　　Action:=xlFilterInPlace, _
　　　　　　　　　CriteriaRange:=myCriteria, _
　　　　　　　　　Unique:=False
　　End If
　　End With
End Sub

注意:Excel2002のみが、このCriteria の書き方が、違っています。

例:
種類　←フィールド名（データ側と、Criteriaには必ず必要です）
ヒレ*　←とワイルドカードが必要です。他のバージョンには必要ありません。

お礼

回答ありがとうございます。
バージョンは2002ですので、フィールド名とワイルドカードを入れました。
しかし、タイトル行のみが残るだけで、データが入っている行全てが非表示のような状態になってしまいました。▼は出ていません。
オートフィルタをいったんかけ、解除すると元に戻りました。

普通にAutoFilterメソッドで、Criteria1:="ヒレ*" で行ったところ、望み通りの結果が得られました。
Criteria1に指定する方法を工夫すれば希望通り行きそうです。

アドバイスありがとうございました。

回答No.4

Wendy02

#1 のWendy02 です。
＞▼は出ていません。
＞オートフィルタをいったんかけ、解除すると元に戻りました。

フィルタオプション自体をご存知ないようにお見受けしました。

私が書いたのは、[データ]－[フィルタ]－[フィルタオプションの設定]の「フィルタオプション」のことです。▼は出ませんから、その代わりにボタンを作ります。

オートフィルタとフィルタオプション(VBAでは、AdvancedFilterといいます）とは、似ていますが、性質が違います。VBAを使うのでしたら、フィルタオプション(AdvancedFilter）をお勧めします。抽出やコピーが、そのメソッドの中で完了するからです。

フィルタオプションのCriteriaの条件の組み合わせは、自由です。下に、何個でもつけることができます。オートフィルタでは、その条件の組み合わせが限られています。

今回は、Criteria は、I列で、作るようになっています。

例えば、

種類　　　　←タイトル行
フィレ*　　←検索条件

なお、ご希望に沿わなかったら、#2 の　KenKen_SPさんのものをお試しください。

回答No.3

KenKen_SP

#2です。

#2のコードを一部訂正いたします。すみません。

【訂正前】

'検索語が空なら全件表示する
.Range("A1").AutoFilter Field:=lngNum

【訂正後】

'検索語が空なら全件表示する
.Range(strDatArea).AutoFilter Field:=lngNum

回答No.2

KenKen_SP

こんにちは。KenKen_SP です。

AutoFilterメソッドを利用した例です。

検索キーはアクティブセルの値となります。空のセルだと全件表示
するようにしました。

また、部分一致検索のためのワイルドカード文字はコード内で追加
しています。

データ見出し範囲や検索フィールド位置は適当にカスタマイズして
下さい。

Sub SampleAutoFilter()

　　Dim strKeyWord As String
　　Dim strDatArea As String
　　Dim lngNum　　 As Long

　　'データ見出し範囲
　　strDatArea = "A1:E1"
　　'検索フィールド位置（データ範囲内で左から数える）
　　lngNum = 1

　　'処理対象となるシートを明示
　　With ActiveSheet
　　　　'オートフィルタ設定
　　　　If Not .AutoFilterMode Then
　　　　　　.Range(strDatArea).AutoFilter
　　　　End If
　　　　'データ抽出の検索語はアクティブセル
　　　　strKeyWord = ActiveCell.Value
　　　　If strKeyWord = "" Then
　　　　　　'検索語が空なら全件表示する
　　　　　　.Range("A1").AutoFilter Field:=lngNum
　　　　Else
　　　　　　'部分一致検索のためワイルドカード文字追加
　　　　　　strKeyWord = "*" & strKeyWord & "*"
　　　　　　'フォルタ実行
　　　　　　.Range(strDatArea).AutoFilter _
　　　　　　　　Field:=lngNum, Criteria1:=strKeyWord
　　　　End If
　　End With

End Sub