• 締切済み

エクセルVBA AdvancedFilterの範囲

エクセルVBAのAdvancedFilterのついて教えてください AdvancedFilterは検索条件をCriteriaRangeで指定するかと思うのですが、そのつど変更することは可能なのでしょうか 現在、B3からO3に検索するための「見出し」が入力されています B4からO4に検索したい文字を入力しCriteriaRange:=Range("B3:O4")としてきたのですが、検索を増やし場合があります B5からO5にも入力し、Range("B3:O5")とすればいいのでしょうが、そのつど検索範囲を変更するのは大変です あらかじめRange("B3:O5")としてしまうと、4行目までしか入力しなかった場合に、5行目がORで検索されるので、余白行が検索されることになりすべてのデータを抽出してしまいます 最大でも10条件用意しておけば足りると思うので、Range("B3:O13")としたいです "空白セルの場合は、上の行をコピーする"と命令させておけば、空白セルがなくなりすべてのデータを抽出してしまうということは回避できるのかな?と考えたのですが、どのように実現するか分かりませんでした それか、"最終行を認識し、そこまでの範囲とする"とか"余白セルを無視する"ことも可能なのでしょうか 自分が思いついたやり方でなくでも構わないので、検索のつど範囲を変更できる方法があれば教えてください よろしくお願いします

みんなの回答

  • tsubuyuki
  • ベストアンサー率45% (699/1545)
回答No.5

> B列に限ることなく、「B3からO13の表の中で、入力されているセルを含む行まで」 なるほど、失礼しました。 だとすると、#3さんの考え方を拝借して、     Range("フィルタをかける範囲").AdvancedFilter Action:=xlFilterInPlace, _         CriteriaRange:=Intersect(Range("B3").CurrentRegion, Columns("B:O")), _         Unique:=False としてやるのが早そうですね。 14行目以降にも何らかの(検索キー以外の)データがあるなら、     Intersect(Range("B3").CurrentRegion, Range("B3:O13")) としてやっても良さそうです。 あ、言い忘れましたが、各Range・Columnsには シート名の指定をお忘れなくなさってくださいね。 #3さま、ありがとうございます。 私も勉強させていただきました。

kidibotkbg
質問者

お礼

追加の返信ありがとうございます No3さんの回答にも書きましたが、A4からA13まで1、2、3、・・・・、10と数字が振ってあり、教えていただいた2つの方法でやってもうまく抽出されません sheet2に検索するめの表を作成しており、 Intersect(Worksheets("sheet2").Range("B3").CurrentRegion, ・・・といった感じでシートを指定しています シートの指定方法が駄目なんですかね・・

全文を見る
すると、全ての回答が全文表示されます。
  • tom04
  • ベストアンサー率49% (2537/5117)
回答No.4

こんにちは! 横からお邪魔します。 とりあえずB~O列の最終行取得だけ・・・ 各列(他の列)に14行目以降にデータがない場合は(1行目には何らかのデータが入っているという前提) Dim endRow As Long endRow = ActiveSheet.UsedRange.Rows.Count これでデータが入っている最終行が取得できると思います。 もし他列に14行目以降にデータがあったり、B~O列内で14行目以降にデータがある場合は Cells(Rows.Count, 1).End(xlUp).Row のような方法では3~13行目内の最終行取得はできませんので Dim i As Long, endRow As Long For i = 13 To 3 Step -1 If WorksheetFunction.CountA(Range(Cells(i, "B"), Cells(i, "O"))) <> 0 Then endRow = i Exit For End If Next i のような感じで行えば 最終行は endRow に格納されます。 ※ AdvancedFilter の直接の回答ではないので、 この程度でごめんなさいね。m(_ _)m

kidibotkbg
質問者

お礼

回答ありがとうございます 私は応用がきくほどVBAを詳しく分かっていませんが、ヒントになりそうですし、おそらく詳しい方が見たら応用できるんでしょうね。。。 ありがとうございました

全文を見る
すると、全ての回答が全文表示されます。
  • n-jun
  • ベストアンサー率33% (959/2873)
回答No.3

No.1です。 列も範囲限定して Intersect(Range("B3").CurrentRegion,Rows("3:13"),Columns("B:O")) こんな感じでは無理かな?

kidibotkbg
質問者

お礼

追加の返信ありがとうございます 前回のn-junさんの回答を参考に、自分も同じコードを作成しました A4からA13まで1から10の数字が振ってあるので しかし、すべてのデータを抽出してしまっているので失敗だと思われます なぜ駄目なのか・・・ 試しにA4の1だけ残し、B4からO4の4行目のみ入力しなければ成功するので、1から10まで入力することで、BからOの列のみ限定できていないということなのだと思うのですが

全文を見る
すると、全ての回答が全文表示されます。
  • tsubuyuki
  • ベストアンサー率45% (699/1545)
回答No.2

スタートは3行目である・・と言うのは変わらないのでしょうか。 だとしたら、最終行を可変にしてやればOKと言うことでしょう。 なので、私からは「(ある列の)最終行を取得する」と言うやり方を提案します。 まぁ、このQ&Aでも良く見かけるやり方ですが、 応用が利きますから、覚えておいて損はありません。 例えば「B列(2列目)の最終行を知りたい」時には   Cells(Rows.Count, 2).End(xlUp).Row としてやると取得できます。 つまり・・エクセル的にシートの最終行(B1048576セル、2003以前ならB65535セル)から 「Ctrl+↑」を押した時に止まる行番号を返してきます。 ちなみに「ある行(例えば3行目)の最終列」を取る場合は   Cells(3, Columns.Count).End(xlToLeft).Column で出来ます。 応用として「B3セルから行方向に連続してデータがあり、その連続データの最終行」なら、   Range("B3").End(xlDown).Row としてもOKです。 これを使って、   CriteriaRange:=Range("B3:O" & Cells(Rows.Count, 2).End(xlUp).Row) あるいは   CriteriaRange:=Range("B3:O" & Range("B3").End(xlDown).Row)   ※B3・B4セルにも必ずデータが入っている、と言うのが前提 としてやるといつでも最終行を指定してやることが出来ますね。 以上、参考まで。

kidibotkbg
質問者

お礼

さっそくの回答ありがとうございます B3からO3まで見出しがあるのですが、4行目以降に入力する場合、それがB列からO列のどのセルに入力されるか分かりません たとえば、4行目はB列(B4)に入力し、5行目はG列(G5)に入力することがあります すると、B列のみの最終行を調べると4行目になりますが、ほかの行ほかの列にも入力されていることを見逃してしまうことになりませんか なので、B列に限ることなく、「B3からO13の表の中で、入力されているセルを含む行まで」としたかったのですが、言葉足らずですみません

全文を見る
すると、全ての回答が全文表示されます。
  • n-jun
  • ベストアンサー率33% (959/2873)
回答No.1

データがどんな感じで入っているのかですけど。 1~2行目に何もデータがなければ Range("B3").CurrentRegion なにかあるなら Intersect(Range("B3").CurrentRegion,Rows("3:13")) などでは無理かな?

kidibotkbg
質問者

お礼

ありがとうございます A列に数字をあらかじめ振っていたので、教えていただいたとおりではだめかもしれませんが、応用すればできそうです 助かりました

全文を見る
すると、全ての回答が全文表示されます。

関連するQ&A

  • VBA Advancedfilterの使用法

    やりたい事 1行目は項目行でズラズラ並んでます。2行目以降がデータです。 A列は商品名です。A列で検索をかけ、商品名1、商品名2、、、、、、商品名12までをA列から探し出し、該当する行全体を別シートにコピーします。現状ではFor Nextループ2重で検索し、とりあえず動作するようになってますが、filterを使った方が早くてすっきりしてると思い、変更したいのです。 ところが、autofilterの検索条件はcriteria1, criteria2と2個まで、3個以上必要な場合はadvancedfilterを使用すると、どこかで読みました。上記の例では12個ですが、実使用では数十個です。 advancedfilterの使い方がよく分りません。 MSDNより 式 .AdvancedFilter(Action, CriteriaRange, CopyToRange, Unique) CriteriaRange(検索条件範囲)が不明です。おそらくここにcriteria1,2に相当することを書くのだろうと思いますが、具体的にどう書けばいいのでしょうか?

  • エクセルVBAでのフィルタオプションについて

    マクロの記録を利用して、自分なりに本を参考に以下のように手直しをしてみました。 やりたいこととしては、 名前の定義で“仕入単価他”とつけてあるデータから sheet1のB列に入力した内容(抽出条件)を sheet2に抽出するということです。 sheet1の抽出条件はB列に入力します。 フィルタオプションの“OR”のようになり、 抽出する条件は複数行です。(列はB列のみ) 以下のようなコードで実行をすると、 B列の一番最初に書いたものの内容を抽出してくるだけで、複数のデータを引っ張ってきてくれません。 いろいろと直してはみたのですが、どうしても最初の条件のみを見て抽出してしまいます。 どのように手直ししてよいのかわからなくなってしまいましたので、教えてください。 Dim 検索 As Range Dim 範囲 As Range Set 検索 = Worksheets(1).Range("B1").CurrentRegion Set 範囲 = Worksheets(1).Range("B65536").End(xlUp).Offset(5) Worksheets(1).Activate Range("仕入単価他").AdvancedFilter Action:= _ xlFilterCopy, CriteriaRange:=検索, _ CopyToRange:=Range("B65536").End(xlUp).Offset(5), Unique:=False Range("B65536").End(xlUp).CurrentRegion.Copy _ Destination:=Worksheets(2).Range("A1") End Sub

  • エクセル マクロ advancedfilter

    以下の内容で問題点を教えて頂ければ幸いです。 cells (2,"A").value = "*" & cells(2,"A").value & "*" Range("D6:E1000").AdvancedFilter xlFilterCopy, CriteriaRange:=Range("A1:A2"), CopyToRange := Range("A4"), Unique:=False セルA2に日本語が入力されていれば、きちんと部分検索されるのですが、英語を入力した場合、うまくいきません。例えば、A2にBaseballと入力した場合、Baseball GameやBaseball Hatは検索されますが、Japanese BaseballやHe is a baseball playerといったものが検索されません。 基本的なことで恐縮ですが、どなたかご教示頂ければ幸いです。

  • エクセル advancedfilterについて

    エクセルのadvancedfilter機能について質問です。 抽出条件のセルに =IF(A1=X,"",1) のように一定の条件を満たさない場合、 空白セルになる式を入れたところ、フィルタがこのセルを空白と認識してくれる時とない時があります。 現在、 =IF(Search!B7="","",Search!B7) こちらでは認識され =IF(B11,TRUE,"") こちらでは認識されません。 どういった条件でこれらの認識が変わっているんでしょうか? 使用しているExcelは2007と2010です。 よろしくお願いします。

  • excel マクロでデータ抽出したい

    excelの抽出をマクロ化しようと思っています。 キー記録で Sheets("data").Range("B11:O714").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Sheets("data").Range("G3:G5"), CopyToRange:=_ Range("B4:O615") , Unique:=False を得たので、これを元にして、条件範囲をオートシェイプのある列を条件にしようと思い、 col = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Column で、オートシェイプの列を取得し、 Sheets("data").Range("B11:O714").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Sheets("data").Range(Cells(3, col), Cells(5, col)),_ CopyToRange:=Range("B4:O615") , Unique:=False としたのですが、エラーになってしまいます。 colを使って条件範囲をするにはどうしたらいいのでしょうか? よろしくお願いします。

  • エクセル2007 VBAについて教えてください。

    顧客情報と販売履歴をソフトからCSVで書き出してシート1とシート2へ貼り付けしてそのデータをシート3へ抽出しているのですが、もっと良い方法があれば教えてください。 顧客情報と販売履歴がソフト上の関係で別々に書き出しされる為、シート1へ顧客情報のみを貼り付けしております。シート2に販売履歴を貼り付けしております。 そのデータを別シート A納品番号 B代引金額 C略称 D客先名 E郵便番号 F住所1 G住所2 H.TEL K納品番号(A列と同じコードです)L伝票No M管理番号 N客先情報 O商品コードP商品名Q数量 R納入単価 S納入金額 T客先コード変換 U商品名半角 へ転記するようにしております。 ここで抽出ボタン(マクロ起動)すると161行目から抽出するようにしております。 Private Sub CommandButton3_Click() Range("K161").Select Range("K1:U149").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "A161:A162"), CopyToRange:=Range("K161"), Unique:=False ActiveWindow.SmallScroll Down:=9 Range("K167").Select Range("K1:U149").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "A167:A168"), CopyToRange:=Range("K167"), Unique:=False ActiveWindow.SmallScroll Down:=9 Range("K173").Select Range("K1:U149").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "A173:A174"), CopyToRange:=Range("K173"), Unique:=False ActiveWindow.SmallScroll Down:=6 Range("K179").Select Range("K1:U149").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "A179:A180"), CopyToRange:=Range("K179"), Unique:=False ActiveWindow.SmallScroll Down:=9 Range("K185").Select Range("K1:U149").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "A185:A186"), CopyToRange:=Range("K185"), Unique:=False Range("K191").Select Range("K1:U149").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "A191:A192"), CopyToRange:=Range("K191"), Unique:=False ActiveWindow.SmallScroll Down:=6 Range("K197").Select Range("K1:U149").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "A197:A198"), CopyToRange:=Range("K197"), Unique:=False ActiveWindow.SmallScroll Down:=6 Range("K203").Select Range("K1:U149").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "A203:A204"), CopyToRange:=Range("K203"), Unique:=False Range("K210").Select Range("K1:U149").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "A210:A211"), CopyToRange:=Range("K210"), Unique:=False ActiveWindow.SmallScroll Down:=9 Range("K216").Select Range("K1:U149").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "A216:A217"), CopyToRange:=Range("K216"), Unique:=False Range("K222").Select Range("K1:U149").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "A222:A223"), CopyToRange:=Range("K222"), Unique:=False そしてこのデータを転送用と言うシート A3納品番号 B3商品名1 C3商品名2 D3商品名3 E3氏名 F3郵便番号 G3住所1 H3住所2 I3住所3 J3名前2 K3電話番号 R3代引き金額 へ書き出ししているのですが、もう少し処理が早く出来る提案はありますでしょうか? 問題なく動いてはいるのですが、少し処理に時間がかかってしまう為、簡単な方法があるかご質問させて頂きました。 皆様の知恵をお貸しください。

  • EXCELのフィルタオプションで

    EXCELでフィルタオプション(AdvancedFilter)を使ったデータの抽出がしたいのですが、 空白以外のセルを抽出するには、検索条件範囲に何と書き込めばいいのでしょうか? オートフィルタのように「<>」と書き込んでもだめでした。(空白セル「=」は出来たのに) お願いします。

  • ExcelのVBAでの抽出

    初心者です。よろしくお願いいたします。 sheet1の"A2"~"C6"に簡単な表を作りました。 A列に人の名前が入力されています。 そこで、A列の名前が"花子"のデータだけを抽出 してSheet2へコピーしたいのです。 そこで試行錯誤の上、下のような記述をしました。 Sub 抽出() Application.ScreenUpdating = False Sheets("sheet2").Activate Sheets("sheet2").Columns("A:C").Clear With Sheets("Sheet1") .Range("A2").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:="花子", CopyToRange:=Sheets("sheet1").Range("A2"), Unique:=False End With Application.ScreenUpdating = True End Sub しかし、うまくいきません(TT) エラー:400 とかでるんですけど なにがいけなんでしょうか・・。 他にもAdvancedFilterを使うさいに気をつけること がありましたらご指導ください。 (項目行の中のセルが統合されていたりすると うまくいかない・・・とかあるんでしょうか。) よろしくご指導ください。お願いいたします。

  • VBAの質問です

    1つめの質問。 Dim Sht2 As Worksheet Dim Sht3 As Worksheet Set Sht2 = Worksheets("sheet2") Set Sht3 = Worksheets("sheet3") Sht2.Range("A5").CurrentRegion.AdvancedFilter _ Action:=xlFilterCopy, _ criteriarange:=Sht2.Range("A132:A133"), _ copytorange:=Sht3.Range("A5"), _ Unique:=False というプログラムで,AdvancedFilterのところを後で繰り返し処理したいと思っているので,まずcriteriarange:=Sht2.Range("A132:A133"), _のところをcriteriarange:=Sht2.Range(Cells(132,1),Cells(33,1)), _としてみたのですがエラーが出てしまいます。なぜでしょうか。また,繰り返し処理するためにはcriteriarange:=Sht2.Range("A132:A133"), _のままではダメなのでしょうか。 2つめの質問。 ある行に何もデータがないときに限りその行を削除するというようなマクロはどうやればいいのでしょうか。出来たとしてもシートの下の方が全部消えてしまうので,適用する範囲を指定する必要がありそうですが。 よろしくお願い致します。

  • エクセルVBAのフィルター機能について

    こんにちわ! エクセルのVBAを使って複数の条件を入力すると結果シートへ吐き出すプログラムを組み込んでいますが、下から五行目のCriteriaRange:=Sheets("検索").Range("A1:R2"), _の.Range("A1:R2")を変更した際に.Range("A1:R3")にすれば条件を指定できるのですがその状態で条件を一つだけ入力し抽出すると抽出できずすべてのデーターが吐き出されてしまいます。 ただし二行抽出データーを埋めるとそのとおりに抽出され結果シートへ吐き出されます。 抽出する条件を入力する際、一つの時もあれば二つの時もあります。そういった事を回避するにはどうすればいいでしょうか? Sub OutputRec() Application.ScreenUpdating = False Sheets("結果").Activate Cells.Clear Sheets("検索").Range("A1").Value = Sheets("DATA").Range("A1").Value Sheets("検索").Range("B1").Value = Sheets("DATA").Range("B1").Value Sheets("検索").Range("C1").Value = Sheets("DATA").Range("C1").Value Sheets("検索").Range("D1").Value = Sheets("DATA").Range("D1").Value Sheets("検索").Range("E1").Value = Sheets("DATA").Range("E1").Value Sheets("検索").Range("F1").Value = Sheets("DATA").Range("F1").Value Sheets("検索").Range("G1").Value = Sheets("DATA").Range("G1").Value Sheets("検索").Range("H1").Value = Sheets("DATA").Range("H1").Value Sheets("検索").Range("I1").Value = Sheets("DATA").Range("I1").Value Sheets("検索").Range("J1").Value = Sheets("DATA").Range("J1").Value Sheets("検索").Range("K1").Value = Sheets("DATA").Range("K1").Value Sheets("検索").Range("L1").Value = Sheets("DATA").Range("L1").Value Sheets("検索").Range("M1").Value = Sheets("DATA").Range("M1").Value Sheets("検索").Range("N1").Value = Sheets("DATA").Range("N1").Value Sheets("検索").Range("O1").Value = Sheets("DATA").Range("O1").Value Sheets("検索").Range("P1").Value = Sheets("DATA").Range("P1").Value Sheets("検索").Range("Q1").Value = Sheets("DATA").Range("Q1").Value Sheets("検索").Range("R1").Value = Sheets("DATA").Range("R1").Value Sheets("DATA").Range("A1").CurrentRegion.AdvancedFilter _ Action:=xlFilterCopy, _ CriteriaRange:=Sheets("検索").Range("A1:R2"), _ CopyToRange:=Sheets("結果").Range("A1"), _ Unique:=False Sheets("結果").Columns("A:R").AutoFit Application.ScreenUpdating = True End Sub

専門家に質問してみよう