Excell のフィルター機能をVBAで使いたい

質問

目下VBA学習中の初心者です
現在取り組んでいるエクセルのマクロで、フィルターオプションを使いたいところがあるのですが、以下の点でうまくできず困っています。
どなたかアドバイスや別の方法などがあれば、ご指導願えないでしょうか

下記の記述にある「CriteriaRange:=Range("e3:g5")」のrange("e3:e5")の「e3:e5」の部分を条件変化に対応できるように、変数（例query-1）に置き換えたいと思いました。

そこで、同じシートのe7にquery-1という範囲名をつけe7にe3:g5を入力した後、上記の部分をRange("=query-1")としたり、
Range("=cell("contents",query-1)")などいろいろ試しましたが、いずれもうまくいきません

Sheets("data1").Range("D10:Q510").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("e3:g5"), CopyToRange:=Range("D10:Q10"), Unique:= _
False

このような場合の、もっとよい方法や、解決法についてどなたか、ご指導願えないでしょうか。よろしくお願いします

tomosato-t

回答No.2

imogasi · ベストアンサー

AdvancedFilterの例。コードは短くを目指しました。
Criteria部分の相対化を図っています。
＜テストデータ＞
Ａ１：Ｂ５に下記を入れる。
コード 値
1 10
2 30
1 15
3 10
4 13
4 19
Ｄ１：Ｅ４に
コード コード
2 3
コード コード
1 4
と入れる。
コマンドボタンを１つ貼り付ける。
<操作＞
（１）Criteriaに当たるセルを範囲指定
（２）コマンドボタンをクリック
＜結果＞
Ｄ１：Ｄ２を範囲指定して、ボタンをクリックすると
結果はＡ１０：Ｂ１１に
コード 値
2 30
----
E１：E２を範囲指定して、ボタンをクリックすると
結果はＡ１０：Ｂ１１に
コード 値
3 10
となる。
＜コード＞
Sheet1のボタンのイベントプロシジュアーに
Private Sub CommandButton1_Click()
Dim s As String
s = Selection.Address
Call Macro1(s)
End Sub
----------
Module1に
Sub Macro1(s As String)
Range("A1:B5").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range(s) _
, CopyToRange:=Range("A10:B14"), Unique:=False
End Sub
を入れておく。その後上記操作をすること。

お礼

imogasiさん
具体的で丁寧なご指導ありがとうございました
おかげさまで、無事問題が解決しました
いろいろな本をみても出ていないことが多く、このような具体的なご指導をいただけることは、初心者にとって心強いかぎりです
心より感謝します
tomosato

回答No.3

Enfant

こんばんは
＞上記の部分をRange("=query-1")としたり、
を
Range(Range("query-1").Value)
とすると？

お礼

Enfantさん
早速のアドバイスありがとうございました
おかげさまで、いろんな解き方を知ることができました
いろいろな本をみても出ていないことが多く、このようなご指導をいただけることは、初心者にとって心強いかぎりです
心より感謝します
tomosato

回答No.1

maruru01

こんにちは。maruru01です。

あまりスマートなやり方ではありませんが。

検索対象範囲がD10:Q510で決まっていて、検索条件範囲を選択しておいて、マクロを実行します。
検索条件範囲の左上と右下のセルの行・列番号を取得するやり方です。

Sub 抽出()

　　Dim StartRow As Long
　　Dim StartCol As Long
　　Dim EndRow As Long
　　Dim EndCol As Long

　　StartRow = Selection.Row
　　StartCOl = Selection.Column
　　EndRow = Selection.Rows(Selction.Rows.Count).Row
　　EndCol = Selection.Columns(Selction.Columns.Count).Column

　　Sheets("data1").Range("D10:Q510").AdvancedFilter Action:=xlFilterCopy, _
　　CriteriaRange:=Range(Cells(StartRow, StartCol), Cells(EndRow, EndCol)), _
　　CopyToRange:=Range("D10:Q10"), Unique:=False

End Sub

お礼

maruru01さん
丁寧なご指導ありがとうございました
おかげさまで、無事問題が解決しました
いろいろな本をみても出ていないことが多く、このようなご指導をいただけることは、初心者にとって心強いかぎりです
心より感謝します
tomosato