VBA初心者の条件一致セルの抽出についての質問
- VBA超初心者が、リストから特定の条件に一致する行を抽出する方法を質問しています。
- 特定のセルに入力された値に一致する行を抽出するVBAコードを作成しましたが、全ての行が抽出されてしまいます。どこが間違っているのか、正しく行を抽出する方法を教えてほしいとのことです。
- 1000行のリストから、特定の条件に一致する行を抽出するVBAコードを作成したいという要望があります。
- ベストアンサー
条件一致セルの抽出について
こんにちは。 VBA超初心者ですが、アドバイスをお願い致します。 仕事で使用するリストがあるのですが、 A=選択欄 B=分類 C=メーカー D=品名 E=品番 となっている表があります。(1000行程で、これからも追加予定) Aで○等を入力(選択)すると、K列に○を入力した行を抽出したいのです。 Sub Adfilter2() Range("A3:H17").AdvancedFilter _ Action:=xlFilterCopy, _ CriteriaRange:=Range("K2"), _ CopyToRange:=Range("K3"), _ Unique:=False End Sub ※K2に○を入力しています。 といったコードを作ってみたのですが、実行すると表全てがコピーされてしまいます・・・。 どこがおかしくて、どこを変えれば○をつけた行のみを抽出できるのでしょうか・・・。 ご教授を宜しくお願い致します。
- yamadahanako3
- お礼率69% (30/43)
- Visual Basic
- 回答数1
- ありがとう数1
- みんなの回答 （1）
- 専門家の回答
質問者が選んだベストアンサー
フィルタオプション(AdvancedFilter)でのデータ抽出 http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/vba_advancedfilter.html 最初の方のワークシートを見て下さい。 CriteriaRange:=Range("B1:B2") とあります。 セルＢ１は”項目名”、Ｂ２は”抽出条件”になってます。 ⇒どの項目に対して条件を出しているのか？ この事が参考になるのではないかと思います。
関連する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代引き金額 へ書き出ししているのですが、もう少し処理が早く出来る提案はありますでしょうか？ 問題なく動いてはいるのですが、少し処理に時間がかかってしまう為、簡単な方法があるかご質問させて頂きました。 皆様の知恵をお貸しください。
- ベストアンサー
- Visual Basic
- inputboxではセル番地が指定できず困っています。
EXCEL2000のVBAで、フィルターオプション機能を自動化したいのですが、 抽出先が変動するので、inputboxでセル番地を選択しようとすると、セルを選択することができず、自分で「A1」などと入力すると、きちんとA1に抽出結果が出てくるのですが、自分でセル番地をinputboxに入力するのではなく、マウスでセル番地を指定したいのですが、どのような方法をすればよかったでしょうか? よろしくお願いします。ちなみ作ったVBAは以下のとおりです。（複数の表から同じ条件で抽出し、inputboxで指定したセル番地に抽出結果を出し、その右側に続けて抽出結果を貼り付けていくという感じで作っています） Sub 抽出() Dim Shouhin1 As String Dim Shouhin2 As String Dim Shouhin3 As String Shouhin1 = InputBox("抽出先を指定してください") Shouhin2 = "d" & Mid(Shouhin1, 2, 5)’二つ目の表の抽出先を指定 Shouhin3 = "g" & Mid(Shouhin1, 2, 5)’３つ目の表の抽出先を指定 Sheets("抽出先").Select Sheets("データ").Range("A5:c44").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Sheets("データ").Range("B1:B2"), CopyToRange:=Range(Shouhin1), _ Unique:=False Sheets("データ").Select Sheets("抽出先").Select Sheets("データ").Range("d5:f44").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Sheets("データ").Range("B1:B2"), CopyToRange:=Range(Shouhin2), _ Unique:=False Sheets("データ").Select Sheets("抽出先").Select Sheets("データ").Range("g5:i44").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Sheets("データ").Range("B1:B2"), CopyToRange:=Range(Shouhin3), _ Unique:=False 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を使うさいに気をつけること がありましたらご指導ください。 (項目行の中のセルが統合されていたりすると うまくいかない・・・とかあるんでしょうか。) よろしくご指導ください。お願いいたします。
- ベストアンサー
- オフィス系ソフト
- 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を使って条件範囲をするにはどうしたらいいのでしょうか？ よろしくお願いします。
- ベストアンサー
- Visual Basic
- ＥＸＣＥＬマクロ セルに入力したシート名から参照
よろしくお願いします。 複数のシートがあり、それぞれ 1109,1110,1111,1112,1201,1202,1203,1204,1205 と名前がついています。 それぞれのシートには月毎のデータが入っています。 Sub Macro1() Columns("F:J").Select Selection.ClearContents Sheets("1205").Columns("A:E").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Range("C4:E5"), CopyToRange:=Range("F2:J2"), Unique:=False End Sub ↑のマクロをSheet3で作りましたが、4行目の「Sheets("1205")」の1205の部分を可変で作れればと 思っています。Sheet3のC3セル内に入力したシート名（1109や1203等）でフィルタ出来ると助かります。 どうぞよろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- エクセル2003 条件抽出したデータを切り取り別シートへ貼り付け
シート1にあるデータから3個のキーワードで抽出したデータを切り取り、シート2に貼り付ける方法を教えてください。 今までは抽出する条件のキーワードが２個以下だったので、オートフィルタのオプションで抽出したデータをコピーしてシート2に貼り付け、シート1で可視セルを選択して削除という方法をとっていました。 今回、条件にするキーワードが３個になったので、フィルタオプションの設定で、シート2のＡ1からＡ4にキーワードを入れて、検索条件範囲を指定してデータを抽出したので、今までの方法が使えなくなってしまいました。 参考までに、↓こんな感じです。 Sheets("Sheet2").Select Range("A1") = "条件" Range("A2") = "キーワード１" Range("A3") = "キーワード２" Range("A4") = "キーワード３" Sheets("Sheet1").Cells.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _ Range("A1:A4"), CopyToRange:=Range("A6"), Unique:=False
- 締切済み
- オフィス系ソフト
- エクセル フィルタオプションについて
教えて下さい。 sheet1～sheet3まであります。 【sheet1】と【sheet2】をフィルタオプション で検索条件範囲が【記号】部分で、 【sheet3】の結果になりますが、 VBAで、どのようにすれば良いのか わかりません。 Sheets("Sheet1").Range("A1:C3").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Range("A1:A2"), CopyToRange:=Range("A3:C150"), Unique:=False Sheets("Sheet2").Range("A1:C6").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Range("A1:A2"), CopyToRange:=Range("A3:C150"), Unique:=False End Sub このプログラムで実行するとSheet2の抽出しか できません。 何が足りないのでしょうか？ 宜しくお願いします。 【sheet1】 A B C 品名 金額 記号 1 いちご 100 06-02 2 りんご 200 06-01 3 みかん 300 06-02 【sheet2】 A B C 品名 金額 記号 1 いちご 500 06-01 2 りんご 1000 06-01 3 みかん 1500 06-02 【sheet3】 A B C 1 記号 2 06-02 3 品名 金額 記号 4 いちご 100 06-02 5 みかん 300 06-02 6 みかん 1500 06-02
- 締切済み
- オフィス系ソフト
- Excel2007のマクロでエラーが発生
初心者です。Excel2007で住所録を作り、特定の条件の人だけ抽出しようと考え、以下のマクロを実行すると、「オブジェクトが見つかりません」というエラーが表示されてしまいます。どう修正したら良いのでしょうか？ Sub Adfilter10() Dim dRng As Range, eRng As Range, cRng As Range Set dRng = Worksheets("入力用").Range("A1").CurrentRegion 'データリスト Set dRng = Worksheets("入力用").Range("M1:M2") '条件範囲 Set eRng = Worksheets("印刷用").Range("A1") '抽出先 eRng.CurrentRegion.ClearContents dRnge.AdvancedFilter_ Action:=xlFilterCopy, _ CriteriaRange:=cRng, _ CopyToRange:=eRng, _ Unique:=False End Sub
- 締切済み
- オフィス系ソフト
- エクセルでの自動抽出がうまくいきません
エクセル２０００で自動抽出機能を使用しましたが最初の行の項目だけ重複して抽出されます。直す方法はありませんか？自動抽出の方法はデータセルを指定してデータ→フィルタ→フィルタオプションの設定→選択範囲内をデータのセルに指定、指定した範囲を抽出先のセル指定、重複するレコードは無視するにチェックをいれｏｋです。なお上記のマクロは次のようになっています。Sub 商品名の集計() ' ' 商品名の集計 Macro ' マクロ記録日 : 2002/6/30 ユーザー名 : ｋｙ ' ' Range("D8:D22").Select Application.CutCopyMode = False Range("D8:D22").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _ "B26:B36"), Unique:=True Range("A26").Select End Sub 以上よろしくお願いいたします。
- ベストアンサー
- オフィス系ソフト
- VBAの質問です
１つめの質問。 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"), _のままではダメなのでしょうか。 ２つめの質問。 ある行に何もデータがないときに限りその行を削除するというようなマクロはどうやればいいのでしょうか。出来たとしてもシートの下の方が全部消えてしまうので，適用する範囲を指定する必要がありそうですが。 よろしくお願い致します。
- ベストアンサー
- オフィス系ソフト
お礼
ご回答ありがとうございます。 指摘していただいたところを訂正してみるときちんと動くようになりました！ ありがとうございました。