• ベストアンサー
  • 困ってます

エクセル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

noname#63196
noname#63196

共感・応援の気持ちを伝えよう!

  • 回答数1
  • 閲覧数221
  • ありがとう数1

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

  • ベストアンサー
  • 回答No.1
  • FEX2053
  • ベストアンサー率37% (7909/21100)

一番簡単で姑息な解決手段。 A1:R3にしておいて、条件がひとつだけの列は、同じ条件をコピーしておく。 抽出条件 条件1 ブランク こうなっている場合、条件1またはブランクになって全件抽出になりますが 抽出条件 条件1 条件1 こうすれば、条件1または条件1になって、条件1しか出てきません。

共感・感謝の気持ちを伝えよう!

関連するQ&A

  • VBAでエラー時にメッセージを表示したい

    こんばんわ! エクセルのVBAについて質問です。 以下のように組み込みDATAシートからフィルターをかけて抽出シートへ結果を表示するようになっていますが、DATAシートにデーターがない状態でするとエラーになりますがその際にDATAシートにデーターが入っていませんとメッセージボックスが出る様にするにはどうすればいいでしょうか? まだまだ勉強中の身ですので教えて頂ければ有難いです。 お手数ですが宜しくお願いします。 Sub 抽出() Application.ScreenUpdating = False Sheets("抽出").Activate Cells.Clear Sheets("抽出").Range("A1").Value = Sheets("DATA").Range("A2").Value Sheets("抽出").Range("B1").Value = Sheets("DATA").Range("B2").Value Sheets("抽出").Range("C1").Value = Sheets("DATA").Range("C2").Value Sheets("抽出").Range("D1").Value = Sheets("DATA").Range("D2").Value Sheets("DATA").Range("A3").CurrentRegion.AdvancedFilter _ Action:=xlFilterCopy, _ CriteriaRange:=Sheets("検索").Range("A1:D2"), _ CopyToRange:=Sheets("抽出").Range("A1"), _ Unique:=False Sheets("抽出").Columns("A:D").AutoFit Application.ScreenUpdating = True End Sub

  • エクセルのエラートラップについて

    エクセルのVBAについて質問です。 以下のように組み込みDATAシートからフィルターをかけて抽出シートへ結果を表示するようになっていますが、DATAシートにデーターがない状態でするとエラーになります. そこで以前エラートラップの方法を教えて頂きました。 オフィス2007では正常に動作します。 試しにオフィス2000で実行するとDATAシートにデーターがあるなしに関わらずDATAシートにデーターがないと処理してしまうのですがエクセル2000では無理なのでしょうか? また回避方法があれば教えて頂きたいのですが、まだまだ勉強中の身ですので教えて頂ければ有難いです。 お手数ですが宜しくお願いします。 Sub 抽出() Application.ScreenUpdating = False Sheets("抽出").Activate Cells.Clear Sheets("抽出").Range("A1").Value = Sheets("DATA").Range("A2").Value Sheets("抽出").Range("B1").Value = Sheets("DATA").Range("B2").Value Sheets("抽出").Range("C1").Value = Sheets("DATA").Range("C2").Value Sheets("抽出").Range("D1").Value = Sheets("DATA").Range("D2").Value On Error GoTo MSG Sheets("DATA").Range("A3").CurrentRegion.AdvancedFilter _ Action:=xlFilterCopy, _ CriteriaRange:=Sheets("検索").Range("A1:D2"), _ CopyToRange:=Sheets("抽出").Range("A1"), _ Unique:=False Sheets("抽出").Columns("A:D").AutoFit Application.ScreenUpdating = True Exit Sub MSG: MsgBox "DATAシートにデーターがない", vbCritical Application.ScreenUpdating = True End Sub

  • Excel フィルタオプション マクロ

    <Excel2013> フィルタオプションで抽出条件を加工し 別シート(抽出結果)に抽出したい。 検索条件で「文字を含む」の場合「=”=*"」など 抽出記号入力するのが分からない人の為に、 検索したい文字だけ入力してVBAで加工して データを抽出したいのですが、上手く加工出来ません。 どうかお知恵をお貸し下さい! ◎例題(実際は1000件位横に広いデータです) 【シート名:青森】 住所            処理No.     青森県青森市南町・・・   10  ・ 青森県五所川原市北町    10 【シート名:秋田】 住所            処理No.     秋田県大館市北町・・・   20  ・ 秋田県秋田市栄町・・・   10 【シート名:抽出結果】      C2      D2    F2      G2 検索条件 抽出シート  住所    抽出シート  住所      秋田    栄              <抽出実行ボタン押下> ★検索条件:シート=秋田 and 住所に『栄』を含むデータを抽出 同シート【A7セル】を基準に抽出データを表示 Sub 抽出() Dim Sh As Worksheet ’* Set Sh = Sheets("抽出結果") Sh.Rows("7:7").Select Range(Selection, Selection.End(xlDown)).Select ' Sh.Range("A7").Select ★検索条件範囲:E2/F2へ加工した条件を設定  '** 抽出条件 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

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

    教えて下さい。 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

  • excel vba DATAの日集計

    excel vba DATAの日集計 いつもお世話になっています。 "DATA"シートのセル"D2"の日付を変えると表の数値が変わるようにしています。 その日毎のデータを"集計"シートの日別の表に飛ぶようにしているのですが、 1日分の転記するセル数が多く、Select Caseで31日分のコードを書くと、あまりにも プロシージャーが大きくなります。(Case1からCase31・・・結果分割してますが) FOR NEXT なのかな~、もっと効率のいい書き方がありましたらよろしくお願いします。 例:"集計"シート1日分は、9行となります。それぞれ"DATA"シートからの転記です。"DATA"シートのF5+F10,G5+G10~AC5+AC10までそれぞれの値を"集計"シートのG5からAD5まで、F6+F12,G6+G12~AC6+AC12までそれぞれの値を"集計"シートのG13からAD13までといった具合です (日の9行はそれぞれ決まったある行とある行の加算です、これが31日分の行があります) Sub macro() Dim myrng As Range Dim c As Range Set myrng = Sheets("DATA").Range("D2") For Each c In myrng Select Case c.Value Case 1 '1行目 Sheets("集計").Range("G5").Value = Sheets("DATA").Range("F5") + Sheets("DATA").Range("F10") | | Sheets("集計").Range("AD5").Value = Sheets("DATA").Range("AC5") + Sheets("DATA").Range("AC10") | | '9行目Sheets("集計").Range("G13").Value = Sheets("DATA").Range("F6") + Sheets("DATA").Range("F12") | | Sheets("集計").Range("AD13").Value = Sheets("DATA").Range("AC6") + Sheets("DATA").Range("AC12")

  • エクセルVBAで範囲を変数で設定する方法?

    Dim i As Integer For i = 1 to 50 とした場合、 セルであれば Sheets("Sheet2").Cells(i, 2).Value = Sheets("Sheet1").Cells(i, 2) のように変数を使えますが、範囲に使う場合にはどう書けばいいのでしょうか? 例えば、 Sheets("Sheet2").Range("A1:G1").Value = Sheets("Sheet1").Range("A1:G1") のような式で、行数を変数にする場合です。 よろしくお願いします。

  • VBAのコードを見ていただけませんか

    いつも、ここのサイトの方々には大変お世話になっております。ありがとうございます。 さてexcel2000で、dataというフォームにデータを格納し、メインのシートから、読みに行って編集するデータベースを作成しようとしています。 とあるサイトを参考にして、コードを作成しましたが、いくら頑張ってもどうしてもエラーが出てしまいうまくいきません。 どうか、コードのチェック・修正内容の提案等をいただけないでしょうか?よろしくお願いいたします。 (1)自分で登録した「IDが見つかりません」という表示しかでず、登録が出来ない (2)dataシートのB列(2列目)が主キー(IDと呼んでいます) です。(メインのシートとデータを照合させる部分) (3)メインのシートのIDはAL1&#65374;AQ1行セルまでを結合したセルに保管しています。 (4)下記コードでCommandButton1ボタンを「登録」と命名し、メインシートで入力したデータをdataシートに変更登録、新規に入力したデータも登録できるようにしたい。 (5)スピンボタンでIDを変化させて、メインフォーム上のデータも変化させたいけど、こちらも同種のエラーが出てしまう。 ■以下コードです。 Private Sub CommandButton1_Click() Dim fRange As Range Dim fRow As Long If (Range("AL1").Value = "") Then 'IDが入力されていない場合 MsgBox "IDを入力して下さい", vbExclamation Exit Sub End If Set fRange = Sheets("data").Columns(2).Find(What:=Range("AL1").Value, _ LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows) If (fRange Is Nothing) Then 'IDが見つからなかった場合 MsgBox "IDが見つかりません", vbExclamation Exit Sub End If fRow = fRange.row 'IDの行位置を求める Sheets("data").Cells(fRow, 1).Value = Range("AZ1:BE1").Value Sheets("data").Cells(fRow, 2).Value = Range("AL1").Value Sheets("data").Cells(fRow, 3).Value = Range("AA1:AO1").Value Sheets("data").Cells(fRow, 4).Value = Range("D5:E5").Value Sheets("data").Cells(fRow, 5).Value = Range("G5").Value Sheets("data").Cells(fRow, 6).Value = Range("I5").Value Sheets("data").Cells(fRow, 7).Value = Range("D5:F7").Value Sheets("data").Cells(fRow, 8).Value = Range("G6:I7").Value Sheets("data").Cells(fRow, 9).Value = Range("E8:E9").Value Sheets("data").Cells(fRow, 10).Value = Range("G8:G9").Value Sheets("data").Cells(fRow, 11).Value = Range("B11:I24").Value Sheets("data").Cells(fRow, 12).Value = Range("B71").Value Sheets("data").Cells(fRow, 13).Value = Range("C71").Value Sheets("data").Cells(fRow, 14).Value = Range("B73").Value Sheets("data").Cells(fRow, 15).Value = Range("C73").Value Sheets("data").Cells(fRow, 16).Value = Range("B75").Value Sheets("data").Cells(fRow, 17).Value = Range("C75").Value   ’・・・・全部でfRow122まであります End Sub

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

    オートフィルタをマクロで書いたのですが、一部うまくいかなくて困っています。 わかる方がいらしたらぜひご教授ください。 商品情報というブックがあり、抽出シート(1枚目)と2枚目のシートにデータが入っています。 2枚目のシートのフィールド名を抽出シートのA1を基準に貼り付けています。 条件をA1:I2に入力し、2枚目のシートの条件に合うものを抽出シートの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

  • Excell のフィルター機能をVBAで使いたい

    目下VBA学習中の初心者です 現在取り組んでいるエクセルのマクロで、フィルターオプションを使いたいところがあるのですが、以下の点でうまくできず困っています。 どなたかアドバイスや別の方法などがあれば、ご指導願えないでしょうか 下記の記述にある「CriteriaRange:=Range("e3:g5")」のrange("e3:e5")の「e3:e5」の部分を条件変化に対応できるように、変数(例query-1)に置き換えたいと思いました。 そこで、同じシートのe7にquery-1という範囲名をつけe7にe3:g5を入力した後、上記の部分をRange("=query-1")としたり、 Range("=cell("contents",query-1)")などいろいろ試しましたが、いずれもうまくいきません Sheets("data1").Range("D10:Q510").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Range("e3:g5"), CopyToRange:=Range("D10:Q10"), Unique:= _ False このような場合の、もっとよい方法や、解決法についてどなたか、ご指導願えないでしょうか。よろしくお願いします tomosato-t

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