• 締切済み

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に相当することを書くのだろうと思いますが、具体的にどう書けばいいのでしょうか?

みんなの回答

  • keithin
  • ベストアンサー率66% (5278/7940)
回答No.1

ご利用のエクセルのバージョンも不明のご相談ですが、まずマクロ以前に、エクセルの使い方を勉強してください。 参照: http://www4.synapse.ne.jp/yone/excel2010/excel2010_filter21.html 最初のサンプルで「担当者」のところに「井上」「上村」の2件が並んでいますが、ここに抽出したい12件を列記します あとは手順通りフィルタの詳細設定(フィルタオプションの設定)の操作を行い、該当のデータが一網打尽で抽出できるところまで、まず手で操作して出来るようになってください。 「新しいマクロの記録」で同操作をマクロに録れば、advancedfilterをどう書けばいいのか教えてくれます。 繰り返して説明すると、advancedfilterのcriteriarangeには、サンプルで示されている通りに抽出条件をワークシート上に作成してください。もちろん、必要なら/そうしたければマクロを使ってcriteriarangeに当てるセル範囲を作成させ利用しても、構いません。

関連するQ&A

  • エクセル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代引き金額 へ書き出ししているのですが、もう少し処理が早く出来る提案はありますでしょうか? 問題なく動いてはいるのですが、少し処理に時間がかかってしまう為、簡単な方法があるかご質問させて頂きました。 皆様の知恵をお貸しください。

  • VBAのAdvancedFilterについて with構文で囲まないとオブジェクト定義エラーになる理由

    エクセルでVBAの下記コードで実行すると、実行時エラー'1004' アプリケーション定義またはオブジェクト定義のエラーとなりますが、 Worksheets("作業用").Activate Worksheets("職員").Range(Cells(6, 1), Cells(Wrow, 12)).AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Range("a6:c8"), CopyToRange:=Range("d6:z2000"), Unique:=False それを下記のようにwith end with構文で囲むとエラーとなりません。 形式的には同じコードに見えるのですが、実質的に何が違うためオブジェクト定義エラーにならないのでしょうか。 AdvancedFilterに限らず、しばしば同様の原因によるエラーに悩まされていますので、ご教示いただければ幸いです。 Worksheets("作業用").Activate With Worksheets("職員") .Range(.Cells(6, 1), .Cells(Wrow, 12)).AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Range("a6:c8"), CopyToRange:=Range("d6:O2000"), Unique:=False End With

  • エクセル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")としたいです "空白セルの場合は、上の行をコピーする"と命令させておけば、空白セルがなくなりすべてのデータを抽出してしまうということは回避できるのかな?と考えたのですが、どのように実現するか分かりませんでした それか、"最終行を認識し、そこまでの範囲とする"とか"余白セルを無視する"ことも可能なのでしょうか 自分が思いついたやり方でなくでも構わないので、検索のつど範囲を変更できる方法があれば教えてください よろしくお願いします

  • エクセル マクロ 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といったものが検索されません。 基本的なことで恐縮ですが、どなたかご教示頂ければ幸いです。

  • 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つめの質問。 ある行に何もデータがないときに限りその行を削除するというようなマクロはどうやればいいのでしょうか。出来たとしてもシートの下の方が全部消えてしまうので,適用する範囲を指定する必要がありそうですが。 よろしくお願い致します。

  • 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を使って条件範囲をするにはどうしたらいいのでしょうか? よろしくお願いします。

  • EXCEL Advancedfilter Name(Criteria)の自動作成

    重複データから重複のないデータを抜き出すため、下記のようにCriteriaRangeを指定せずに、Advancedfilterを実行していますが、その際にシートの特定のセルにCriteriaという名前(Nameオブジェクト)が自動的に作成され、それが残る現象が生じます。 シートにその名前(Criteria)が残ると、別のSUBで重複データから重複のないデータを抜き出すためAdvancedfilterを実行すると機能しません(表題部だけ抜き出してくる)。 そこで、2点ご教示いただければ幸いです。 1 Criteriaを残さないAdvancedfilterの実行方法 2 残ってしまうCriteriaを削除する方法として、下記のコードを加えていますが、Namesコレクションの特定のName(Criteria)を特定して削除させていますが、この方法は=を使っていることが、後日のコード解析を分かりづらいものにするため、避けた方がよいと別に指導を受けているため、これ以外の効率的な方法があればご教示願います(例えば、Nameのプロパティを変更する方法による対処方法)。 Criteriaを削除するコード   Dim Objname As name For Each Objname In ActiveWorkbook.Names If Objname.name = "作業用シート!Criteria" Then Objname.Delete End If Next Objname Advancedfilterのコード   With Worksheets("作業用シート") M = .Range("B10000").End(xlUp).Row .Range(.Cells(6, 5), .Cells(M, 5)).AdvancedFilter _ Action:=xlFilterCopy, _ CopyToRange:=.Range("AA6:AA2000"), Unique:=True end with  

  • excelでAdvancedFilterを使って重複データを削除したい。

    初心者質問で申し訳ありません。 重複データを削除したいんですが、調べたところ AdvancedFilterを使って・・・とのことでした。 Sheets("コピー元sheet").Range("範囲").AdvancedFilter _ Action:=xlFilterCopy, _ CopyToRange:=Sheets("コピー先sheet名 ").Range("範囲"), _ Unique:=True ということは分かったのですが、「どの項目の重複 を削除したいのか?」というのはどこで指定するのでしょうか・・・。(例:B列の「部署」という項目の列で重複している部署があったらデータを削除したい・・・等) 例文が見苦しかったらごめんなさい!!!

  • excel2007VBA 二つの動作の繰り返し処理

    excel2007でマクロを勉強し始めたばかりです。VBAの繰り返し処理をしたいのですが、以下のようなマクロの請求書個別発行を一括発行にしたいと考えています。繰り返し開始から、終了までを、数値がなくなるまで繰り返したい場合、どのようになるでしょうか。よろしくお願いします。 Sub 請求書個別発行() ' ' 請求書個別発行 Macro ' ' Range("A3:R24").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "売上一覧表!Criteria"), CopyToRange:=Range("W6:AN50"), Unique:=False    Sheets("得意先").Select Range("C3:O90").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "得意先!Criteria"), CopyToRange:=Range("R6:AD325"), Unique:=False 繰り返し開始 Sheets("売上一覧表").Select Range("T4").Select   (T4からT5,T6,T7、、、と降順に値がなくなるまで選択される。) Selection.Copy        (T4=Y4)  Range("Y4").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Range("A3:R24").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "売上一覧表!Criteria"), CopyToRange:=Range("W6:AN50"), Unique:=False Sheets("請求書").Select Range("B16").Select  (B16から、B17、B18,,,と降順に値がなくなるまで選択される。)   Selection.Copy       (B16=I6) Range("I6").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("請求書").Select Application.Dialogs(xlDialogPrint).Show 繰り返し終了 End Sub 以下は自分なりに考えたVBAですが、エラーになります。 Sub 請求書集計発行() ' ' 請求書発行 Macro ' ' Range("A3:R24").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "売上一覧表!Criteria"), CopyToRange:=Range("W6:AN50"), Unique:=False Sheets("得意先").Select Range("C3:O90").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "得意先!Criteria"), CopyToRange:=Range("R6:AD325"), Unique:=False Dim wst1 As Worksheet Dim wst2 As Worksheet Set wst1 = ThisWorkbook.Worksheets("売上一覧表") Set wst2 = ThisWorkbook.Worksheets("請求書") Dim i As Long Dim j As Long For i = 4 To 100 For j = 16 To 100 If wst1.Range("T" & i) <> "" And Not IsNull(wst1.Range("T" & i)) Then If wst2.Range("B" & j) <> "" And Not IsNull(wst2.Range("B" & j)) Then myrow = wst1.Cells(Rows.Count, 1).End(xlUp).Row + 1 myrow = wst2.Cells(Rows.Count, 1).End(xlUp).Row + 1 wst1.Range("T" & myrow) = wst1.Range("Y4") Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Range("A3:R24").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "売上一覧表!Criteria"), CopyToRange:=Range("W6:AN50"), Unique:=False Sheets("請求書").Select wst2.Range("B" & myrow) = wst2.Range("I6") Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("請求書").Select Application.Dialogs(xlDialogPrint).Show End If Next i Next j End Sub

  • 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を使うさいに気をつけること がありましたらご指導ください。 (項目行の中のセルが統合されていたりすると うまくいかない・・・とかあるんでしょうか。) よろしくご指導ください。お願いいたします。

専門家に質問してみよう