• ベストアンサー

フィルタ オプションの設定(データ抽出)　マクロ

マクロを使って、「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

画像を拡大する
  • ihuyi
  • お礼率73% (158/216)

質問者が選んだベストアンサー

  • ベストアンサー
  • hige_082
  • ベストアンサー率50% (379/747)
回答No.4

＃３の補足から ＞セル（Ｉの欄）をもう一つと行も２０行ほど増やしたいのですが 一寸意味不明です？？？ 検索範囲をB列～I列までとすると言うことでしょうか？ 検索範囲の最終行はB列の「NO.」の入力によって決まるので 20行多めにNO.を入力すれば済むように思いますが違うのでしょうか？ ＞設定の順番も教えて頂けますと 設定とは？ AdvancedFilterの使用方法ということでしょうか？ '検索範囲をB列～I列までとするならのみの修正 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:I" & myRow2).ClearContents End If Sheets("Sheet1").Range("B5:I" & myRow1).AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Sheets("Sheet1").Range("B2:B3"), CopyToRange:=Sheets("Sheet2").Range("B5"), Unique:=False End Sub

ihuyi
質問者

お礼

「一寸意味不明」なるほどです。初心者ですのでもうしわけありません。「検索範囲をB列～I列までとすると言うことでしょうか」その通りです。「AdvancedFilte」の意味はよくわかりませんが、色々とお考えいたた゜きましてありがとうございます。「'検索範囲をB列～I列までとするならのみの修正」でできました。ほんとうにありがとうございました、完成できました。また、次回にもよろしくお願いします。

その他の回答 (3)

  • hige_082
  • ベストアンサー率50% (379/747)
回答No.3

こうではないですか？ Sheets("Sheet1").Range("B5:H" & myRow1).AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Sheets("Sheet1").Range("B2:B3"), CopyToRange:=Sheets("Sheet2").Range("B5"), Unique:=False 参考まで

ihuyi
質問者

補足

もう一つお教えください。できました、ありがとうございました。設定のやり方に問題もありました。初心者で初めての挑戦でした。それで、セル（Ｉの欄）をもう一つと行も２０行ほど増やしたいのですが、教えて頂けませんか。 　また、やり方は初心者ですので、設定の順番も教えて頂けますと、大変ありがたいのですが、よろしくお願いします。

  • ka_na_de
  • ベストアンサー率56% (162/286)
回答No.2

＃１です。 検証してみましたが、ihuyiさんのコードで 問題なく抽出できました。 どのような場合に抽出できないのか、 もっと具体的に示して頂けませんか？

  • ka_na_de
  • ベストアンサー率56% (162/286)
回答No.1

こんばんは。 ざっと、見ただけで検証してません。 Sheets("Sheet1").Range("B2:H" & myRow1).AdvancedFilter Action:=xlFilterCopy, _ 　　CriteriaRange:=Sheets("Sheet2").Range("B2:B3"), _ 　　CopyToRange:=Sheets("Sheet2").Range("B5"), Unique:=False としてみてはどうでしょうか？

ihuyi
質問者

お礼

色々とおせわになりました。ありがとうございました。

  1. カテゴリ
  2. パソコン・スマートフォン
  3. ソフトウェア
  4. オフィス系ソフト

関連するQ&A

  • Excel　マクロ　担当者別抽出で列が重複する

    お世話になります。 WinXP　Office2007です。 http://www.eurus.dti.ne.jp/~yoneyama/Excel/filter3.htm こちらを参考に担当者別に別Sheetにまとめたく作成してます。 抽出自体はできるのですが、Z列以降が反映されません。 マクロに対する知識が乏しく、教えて頂ければ幸いです。 参考URLでは列はB～Hまでですが私の加工しているものは C～AKまであります。抽出しますとC～Zまではきちんと反映されますが その後AA～AKまでがN～Yに置き換わって反映されています。 コードはこちらです。 Sub 担当者() Dim myrow1 As Long, myrow2 As Long myrow1 = Sheets("全部").Range("B65536").End(xlUp).Row myroe2 = Sheets("担当").Range("B65536").End(xlUp).Row If myrow2 >= 5 Then Sheets("担当").Range("B5:AK" & myrow2).crearcontents End If Sheets("全部").Range("C15:AK" & myrow1).AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Range("B2:B3"), CopyToRange:=Range("B5"), Unique:=False End Sub よろしくお願い致します。

  • フィルタオプションの設定の条件における文字について

    フィルタオプションの設定の検索条件範囲で指定した条件が半角・全角や大文字・小文字にかかわらず抽出するということはできますか？ 商品情報というブックがあり、抽出シート(１枚目）と２枚目のシートにデータが入っています。 ２枚目のシートのフィールド名を抽出シートのA1を基準に貼り付けています。 条件をA1：I3あたりに入力し、２枚目のシートの条件に合うものを抽出シートのA5以降に取り出すマクロを書いています。次回マクロを起動させたときにA5以降にデータがあれば削除させます。 いろいろな方に教えていただいて下記のようにできあがったのですが、ちょっと問題があって 質問しています。 Dim myRow1 As Long, myRow2 As Long myRow1 = Sheets(2).Range("A" & Rows.Count).End(xlUp).Row myRow2 = Sheets("抽出").Range("A" & Rows.Count).End(xlUp).Row If myRow2 >= 5 Then Sheets("抽出").Range("A5:I" & myRow2).ClearContents Sheets("抽出").Range("A5:I" & myRow2).ClearFormats Sheets(2).Range("A1:I" & myRow1).AdvancedFilter _ Action:=xlFilterCopy, _ CriteriaRange:=Sheets("抽出").Range("A1").CurrentRegion, _ CopyToRange:=Sheets("抽出").Range("A5"), Unique:=False End Sub 現状では元データが全角だと半角で入力すると抽出されず、元データが小文字だと大文字は抽出されません。 いちいち元データの状態を把握しての検索になってしまいます。 このマクロを修正して全角・半角もしくは小文字・大文字にかかわらず抽出できるようにすることは可能でしょうか？ どなたかご存知の方がいらっしゃれば教えていただけないでしょうか？

  • マクロの修正ができません

    エクセルのマクロで下記の作業をしています。 よくわからないまま使っているので障害箇所がわかりません。 教えていただけないでしょうか・・ 説明の仕方も下手で申し訳ありませんがよろしくお願いいたします。 [マクロの用途] ・別シートに請求データを作成しています。 ・請求番号を入力するセルに請求番号を入力します。 ・登録したマクロボタンを押すと抽出範囲に該当する請求書のデータが抽出されます。 [障害の内容] 請求データが４行以上になると、３行まで抽出され、 ４行以降は抽出されません。 以下はマクロの内容です。 Sub 抽出() ' ' 抽出 Macro ' マクロ記録日 : 2007/2/19 ユーザー名 : ＊＊＊' Dim myRow1 As Long, myRow2 As Long myRow1 = Sheets("データ").Range("B65536").End(xlUp).Row myRow2 = Sheets("抽出範囲").Range("B65536").End(xlUp).Row If myRow2 >= 5 Then Sheets("抽出範囲").Range("A4:Q40" & myRow2).ClearContents End If Sheets("データ").Columns("A:Q").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Range("A1:A2"), CopyToRange:=Range("A4:Q40"), Unique:=True End Sub

  • フィルタオプション設定をVBAで処理したものに、さらに連番（ナンバリング）もされるようにVBAを作成し直したい。

    よろしくおねがいします。 フィルタオプション設定を下記のようにVBAにて既に作成したものがあります。（ボタンをクリックするだけで、データが抽出されるようにしてあります。） Sub Macro1() Dim myRow1 As Long, myRow2 As Long myRow1 = Sheets("職員名簿").Range("B65536").End(xlUp).Row myRow2 = Sheets("東京都").Range("B65536").End(xlUp).Row If myRow2 >= 5 Then Sheets("東京都").Range("B5:T" & myRow2).ClearContents End If Sheets("職員名簿").Range("A2:S" & myRow1).AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Sheets("データ").Range("A2:F32"), CopyToRange:=Range("B5:T5"), _ Unique:=False End Sub この実行時に、A列に抽出されたデータの件数を自動的に１からの連番にて入る（ナンバリングされる）ように、VBAを追加作成し直したいのですが、 どうしたら良いか分からず、教えていただきたいと思います。 既に作成してある、VBAを実行した後に、A列のセル一つ一つに、 =SUBTOTAL(3,B$6:B6) などのように、関数を入れて抽出した行分、コピーしていけばいいのではないか。とおっしゃるかもしれませんが、 作成は私の仕事なのですが、実際これを使っていくのは、私ではなく上司なので（エクセル超初心者で使いこなせない）、 データ抽出と同時に、A列に番号が連番されていくように、 ボタン一つで、データ抽出とナンバリングができるように、 VBAを追加作成し直したいのです。 どういう命令文を追加すればよろしいのでしょうか。 よろしくおねがいいたします。

  • マクロ！一覧から別シートへの抽出

    商品の納期や、集金日などが一覧になっている【一覧】シートがあります。 他に集金月別にシート【4月】【5月】…と一年分12シートあります。 一覧シートは、空欄セルに店舗名や納期などを随時入力していき、データは増えていくのみです。 下記のマクロでデータの抽出・抽出結果のコピー・貼り付けを行っています。 Sub Macro4() ' ' Macro4 Macro ' 集金月で抽出 Dim myRow1 As Long, myRow2 As Long myRow1 = Sheets("一覧").Range("B65536").End(xlUp).Row myRow2 = Sheets("4月").Range("B65536").End(xlUp).Row If myRow2 >= 3 Then ★ Sheets("4月").Range("A3:P" & myRow2).ClearContents End If Sheets("一覧").Range("A3:P" & myRow1).AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Range("G1:H2"), CopyToRange:=Range("A4:P4"), Unique:=False End Sub 一覧以外のシート全てに、上記マクロを登録した【抽出】ボタンを設置し G1:H1セルには集金日と検索項目のタイトル G2セルには>=4/1、H2セルには<=4/30 抽出ボタンをクリックして一覧から取得しています。　 マクロは、説明が載っているHPからの独学なのでどう応用すれば良いのかがわかりません。 一覧に追加入力し、4月シートに4月分抽出。次に5月シートに5月分抽出とすると4月シートの抽出結果が消えてしまいます。 そこで、★で指定している4月シートではなく、現在選択している”シート”としたいのですが、どのように記述すればよいかわかりません。 自分が分からない事を、どう検索してよいかも分からなくなってきたので、どうかアドバイスお願いします。

  • オートフィルタをマクロで書いたのですが、一部うまくいかなくて困っていま

    オートフィルタをマクロで書いたのですが、一部うまくいかなくて困っています。 わかる方がいらしたらぜひご教授ください。 商品情報というブックがあり、抽出シート(１枚目）と２枚目のシートにデータが入っています。 ２枚目のシートのフィールド名を抽出シートのA1を基準に貼り付けています。 条件をA1：I2に入力し、２枚目のシートの条件に合うものを抽出シートのA5以降に取り出すマクロを書いています。次回マクロを起動させたときにA5以降にデータがあれば削除させます。 そこで問題なのですが、A1：I2の条件だとA列からI列までのフィールド名に対する条件を 1行入力することができますが、同じ行になるのでAND条件になってしまいます。 本当は条件列をI3までにして、条件を2行にわたって書いて　または条件も検索したいのです。 ただ、または条件は入力する場合と入力がない場合があります。 条件をA1:I3（3行目)に変更してマクロを実行すると、または 条件がある場合はちゃんとでるのですが、条件がない場合はすべてでてきてしまいます。 どのようにすればA1:I3に変更して、2行目と3行目に条件があった場合はその条件で該当するものを 抽出し、特に3行目に条件がない場合は2行目だけの条件で抽出できるのでしょうか？ （2行目のAnd条件検索と3行目のまたは条件検索ができますでしょうか？） Dim myRow1 As Long, myRow2 As Long myRow1 = Sheets(2).Range("A" & Rows.Count).End(xlUp).Row myRow2 = Sheets("抽出").Range("A" & Rows.Count).End(xlUp).Row If myRow2 >= 5 Then Sheets("抽出").Range("A5:I" & myRow2).ClearContents Sheets("抽出").Range("A5:I" & myRow2).ClearFormats End If Sheets(2).Range("A1:I" & myRow1).AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Worksheets("抽出").Range("A1:I2"), CopyToRange:=Sheets("抽出").Range("A5"), Unique:=False End Sub

  • エクセルのマクロで検索・抽出したデータを修正及び更新して元データに反映

    エクセルのマクロで検索・抽出したデータを修正及び更新して元データに反映させたい。 Sheet1に元データが行単位で入力されています。。 　　A　　　B　　　　C　　　　D　　　　E F 1　日付 顧客名 契約料 担当 回収日 回収金額 2 3 | 50 Sheet2で複数条件でフィルタオプションをマクロで実行し結果を表示ています。 　　A　　　　B　　　　C　　　D　　　　E 1　日付～　日付マデ　顧客名　担当者 2　1/1　　 2/28 　　　　高橋　　　　　　--------->検索条件 3 4　日付 顧客名 担当 回収日 回収金額 5　-------------------------------------->抽出結果 6　-------------------------------------->抽出結果 7　-------------------------------------->抽出結果 マクロは下記の通りです。 Public Sub 検索() Dim myRow1 As Long, myRow2 As Long '----Sheet1とSheet2のA列で最終行を捜します。 myRow1 = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row myRow2 = Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row '----Sheet2のA5以下が入力されていたらクリアします。 If myRow2 >= 5 Then Sheets("Sheet2").Range("A5:P" & myRow2).ClearContents End If '----フィルタオプションの設定で抽出します。 '----元データはSheet1、抽出条件はSheet2のA1:D2、抽出先はSheet2のA4:E4です。 Sheets("Sheet1").Range("A1:F" & myRow1).AdvancedFilter _ Action:=xlFilterCopy, _ CriteriaRange:=Sheets("Sheet2").Range("A1:D2"), _ CopyToRange:=Sheets("Sheet2").Range("A4:E4"), _ Unique:=False End Sub 抽出結果の各セルデータを必要に応じて変更・修正（選出結果を直に）をしそれを元データ に反映（上書き？）させるようなマクロを作成したいです。 どなたかご指導よろしくお願いいたします。 うまく説明できないので画像を添付します。

  • エクセル　マクロ　抽出

    教えてください。 ○と記入されたセルを参照して、一つ上のセル・A列にある同じ行のセル・ 9行目にある同じ列のセルを抽出しようとしています。 下記の通り入力すると　行数＝値.Rowでエラーが出たしまいました。 試行錯誤頑張りましたが解決できそうにありませんのでお力を貸して頂けないでしょうか。 Sub 抽出() Dim i, 行数, 列数 As Long Dim 値 As Range i = 0 行数 = 値.Row 列数 = 値.Column For Each 値 In Sheets("sheet1").Range("C12:R171") If 値.Value = "○" Then i = i + 1 With Sheets("sheet2") .Cells(i, 3).Value = Sheets("sheet1").Cells(行数, 1).Value .Cells(i, 4).Value = Sheets("sheet1").Cells(9, 列数).Value .Cells(i, 5).Value = 値.Offset(-1, 0).Value End With End If Next End Sub

  • セルの値から任意の文字のみを抽出する

    こんにちは。 VBA勉強中です。 どうしても詰まってしまったので力を貸してください。・゜・(ノД｀)・゜・。 Sheet１にはA列～J列にデータが入っています（行数は3行目～□行目・・・都度変わります） Sheet2には抽出したい文字の一覧（仮に禁止ワードとします）がB列5行目～○行目まで入ってます。 質問としてはSheet１のB列、D列、F列のそれぞれの値より禁止ワードを抽出する。 1つのセルに禁止ワードが0～最大5つ入っている時にK列から→方向に禁止ワードを並べて行くといった 感じです。 わかりにくくてすみませんが宜しくお願い致します。 以下自分で考えてみたコードです。。 これだと始めのB列のみ抽出に成功しましたがその他の列からは抽出できず・・・。゜(PД｀q。)゜。 列Bで使用したコードをD列、F列にも使えると下に数値のみ変えて羅列しただけだからでしょうか；ｗ； 本当に初心者ですみません。。 以下コードです。 Sub 禁止ワード抽出() Dim SR As Integer , LR As Integer, SR2 As Integer , LR2 As Integer , LR3 As Integer , LR4 As Integer Dim i As Long , j As Long , k As Long , m As Long Dim KINSHI As Variant SR = 3 SR2 =5 LR = Sheets("Sheet1").Range("B" Rows.Count).End(xlUp).Row LR2 = Sheets("Sheet1").Range("D" Rows.Count).End(xlUp).Row LR3 = Sheets("Sheet1").Range("F" Rows.Count).End(xlUp).Row LR4 = Sheets("Sheet2").Range("B" Rows.Count).End(xlUp).Row For j = SR2 To LR4 KINSHI = Sheets("Sheet2").Cells(j , 2).Value For i = SR To LR If Sheets(Sheet1).Cells(i , 2).Value Like ("*" & KINSHI & "*") Then If Cells(i , 10) = "" Then Cells(i , 10) = KINSHI Else 　 If Cells(i , 10 + 1) = "" Then Cells(i , 10 + 1) = KINSHI 　　　　　　　　　　 Else 　 If Cells(i , 10 + 2) = "" Then Cells(i , 10 + 2) = KINSHI Else 　 If Cells(i , 10 + 3) = "" Then Cells(i , 10 + 3) = KINSHI Else 　 If Cells(i , 10 + 4) = "" Then Cells(i , 10 + 4) = KINSHI End If End If End If End If End If End If Next i , j 以下上記コードをD列、F列バージョンで並べています・・・・ End Sub 恐らくOffsetプロパティを使う方がいいと思いましたが中々うまくいかず 自分なりに色々考えてみてこんな残念な結果になってしまいましたが 皆様のお力添えどうぞ宜しくお願い致します。

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

    マクロの記録を利用して、自分なりに本を参考に以下のように手直しをしてみました。 やりたいこととしては、 名前の定義で“仕入単価他”とつけてあるデータから ｓｈｅｅｔ1のＢ列に入力した内容(抽出条件）を ｓｈｅｅｔ２に抽出するということです。 ｓｈｅｅｔ１の抽出条件はＢ列に入力します。 フィルタオプションの“ＯＲ”のようになり、 抽出する条件は複数行です。(列はＢ列のみ） 以下のようなコードで実行をすると、 Ｂ列の一番最初に書いたものの内容を抽出してくるだけで、複数のデータを引っ張ってきてくれません。 いろいろと直してはみたのですが、どうしても最初の条件のみを見て抽出してしまいます。 どのように手直ししてよいのかわからなくなってしまいましたので、教えてください。 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

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

あなたにピッタリな商品が見つかる！ OKWAVEセレクト

質問する