- 締切済み
エクセル フィルタオプションについて
教えて下さい。 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
- e----n
- お礼率0% (0/1)
- オフィス系ソフト
- 回答数1
- ありがとう数0
- みんなの回答 （1）
- 専門家の回答
みんなの回答
- taocat
- ベストアンサー率61% (191/310)
おはようございます。 抽出結果を表示するセル範囲が同じ（A3:C150）になってますから Sheet1の結果の上にSheet2の結果が上書きされてるだけです。 それを避けるためにSheet2の抽出結果を表示するセルは Sheet1の抽出結果の最後のセルの次のセルを指定ればいいわけです。 そして最後に、Sheet2の見出しも抽出されてますからそれを削除。 --------------------------------------------------------------- Sub Test() Dim myCell As Range Sheets("Sheet1").Range("A1:C2000").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Range("A1:A2"), CopyToRange:=Range("A3"), Unique:=False Set myCell = Range("A65536").End(xlUp).Offset(1) Sheets("Sheet2").Range("A1:C2000").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Range("A1:A2"), CopyToRange:=myCell, Unique:=False myCell.EntireRow.Delete xlShiftUp End Sub -------------------------------------------------------------------------- それから抽出範囲は範囲の左上をひとつ指定する。 またリスト範囲は、データの追加にも耐えられるように余分に設定することをお勧めします。 例えば、A1:C2000 とか(上記コード） 一行目が見出し行であれば、あっさりと列全体、A:C とか。 以上です。
関連する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
- 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等）でフィルタ出来ると助かります。 どうぞよろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- Excel フィルタオプション マクロ
＜Excel2013＞ フィルタオプションで抽出条件を加工し 別シート(抽出結果）に抽出したい。 検索条件で「文字を含む」の場合「＝”＝＊"」など 抽出記号入力するのが分からない人の為に、 検索したい文字だけ入力してVBAで加工して データを抽出したいのですが、上手く加工出来ません。 どうかお知恵をお貸し下さい！ ◎例題（実際は1000件位横に広いデータです） 【シート名：青森】 住所 処理No. 青森県青森市南町・・・ 10 ・ 青森県五所川原市北町 10 【シート名：秋田】 住所 処理No. 秋田県大館市北町・・・ 20 ・ 秋田県秋田市栄町・・・ 10 【シート名：抽出結果】 Ｃ2 Ｄ2 F2 G2 検索条件 抽出シート 住所 抽出シート 住所 秋田 栄 ＜抽出実行ボタン押下＞ ★検索条件：シート＝秋田 and 住所に『栄』を含むデータを抽出 同シート【Ａ7セル】を基準に抽出データを表示 Sub 抽出() Dim Sh As Worksheet ’* Set Sh = Sheets("抽出結果") Sh.Rows("7:7").Select Range(Selection, Selection.End(xlDown)).Select ' Sh.Range("A7").Select ★検索条件範囲：E2／F２へ加工した条件を設定 '** 抽出条件 If Sh.Range("C2").Value <> "" Then Sh.Range("F2").Value = "=” & Sh.Range("C2").Value End If If Sh.Range("D2").Value <> "" Then Sh.Range("G2").Value = "=”&"=＊" & Sh.Range("D2").Value & "＊" End If ’* Select Case Range("C2").Value Case "青森" Sheets("青森").Range("1:cx2000").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Range("F1:G2"), CopyToRange:=Range("A7"), Unique:=False Case "秋田" Sheets("秋田").Range("1:Cx2000").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Range("F1:G2"), CopyToRange:=Range("A7"), Unique:=False End Select End Sub
- 締切済み
- Excel（エクセル）
- 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を使うさいに気をつけること がありましたらご指導ください。 (項目行の中のセルが統合されていたりすると うまくいかない・・・とかあるんでしょうか。) よろしくご指導ください。お願いいたします。
- ベストアンサー
- オフィス系ソフト
- フィルターオプションの設定をマクロで
フィルターオプションの設定をマクロでできるように設定していますが、うまくいきません。 アポというシートから訪問というシートにフィルターオプションの設定で情報を抽出して、 マクロで簡単に繰り返せるようにしたいです。 手動でフィルターオプションの設定を行うとB2～N10まで反映するんですが、 それを記録したマクロを実行すると、B列の値しか反映しません。 ただ、一度反映したセルを全削除してからマクロを実行すると、 一度目と同じように全て反映します。 －－－－－－－－－－－－－－－－－－－－－－－－ Sub アポ→訪問() ' ' アポ→訪問 Macro ' ' Application.CutCopyMode = False Sheets("アポ").Cells.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _ Range("A1:A2"), CopyToRange:=Range("B1"), Unique:=False －－－－－－－－－－－－－－－－－－－－－－－－ 始めての質問で、マクロについての知識も少ないので わかりづらいかもしれませんが、よろしくお願いします。
- 締切済み
- Excel（エクセル）
- フィルタ オプションの設定(データ抽出) マクロ
マクロを使って、「sheet1」のデターを「sheet２」へ抽出するのですが、Webで最適なものがあったので、その指示通りにやりました。その例題は再現できました。しかし、それを自分に合うように設定し直すとどうしてもできません。そこで気づいたのは、「No. 月日 項目名 収入 支出 摘要 購入店名」の各セルが何らかの関係があるのではと思ったのです。この項目を変えたて自分独自のものにしたいのですが、変えたり消してしまうと抽出できません。どこをどのようにしたらよいのか教えて頂けませんか。 Sub Macro2() Dim myRow1 As Long, myRow2 As Long myRow1 = Sheets("Sheet1").Range("B65536").End(xlUp).Row myRow2 = Sheets("Sheet2").Range("B65536").End(xlUp).Row If myRow2 >= 5 Then Sheets("Sheet2").Range("B5:H" & myRow2).ClearContents End If Sheets("Sheet1").Range("B2:H" & myRow1).AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Range("B2:B3"), CopyToRange:=Range("B5"), Unique:=False End Sub
- ベストアンサー
- オフィス系ソフト
- マクロのフィルター機能を使って
マクロのフィルター機能を使って”Unique:=True”、重複するデータから 別のシートに重複しないようにデータを抽出使用としているのですが シートに書き込んだ際になぜか最初のデータだけが重複データとして残っています。 いろいろ試してみたんですが、よく分かりません。 以下のコマンドが、実際のものです。 Range("A3:A65536").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets("Sheet1").Range("A2"), Unique:=True データとしては、以下のようなものです。 Ａ 1 項目 2 番号 3 STUG1208 4 STUG1208 5 STUG1208 6 STUG1209 7 STUG1210 8 STUG1207 9 STUG1206 10 STUG1208 11 STUG1202 12 STUG1204 よろしくお願いします。
- ベストアンサー
- Visual Basic
- 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
- ベストアンサー
- オフィス系ソフト
- 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
- ベストアンサー
- オフィス系ソフト
補足
こんばんは。 taocatさんありがとうございました。 実行してみました。 1度目は、出来ました！！続けて 違う記号【06-01】を実行すると エラーがでました。 CriteriaRange:=Range("A1:A2"), CopyToRange:=Range("A3"),Unique:=False の部分を CriteriaRange:=Range("A1:A2"), CopyToRange:=Range("A3:C2000"),Unique:=False に、変更したらいけました。 Sub Test() Dim myCell As Range Sheets("Sheet1").Range("A1:C2000").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Range("A1:A2"), CopyToRange:=Range("A3:C2000"), Unique:=False Set myCell = Range("A65536").End(xlUp).Offset(1) Sheets("Sheet2").Range("A1:C2000").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Range("A1:A2"), CopyToRange:=myCell, Unique:=False myCell.EntireRow.Delete xlShiftUp >Range("A65536").End(xlUp).Offset(1) このコードを教えてもらい勉強になりました。 今後、色々と利用できると思いますので 忘れないようにしたいです。