• ベストアンサー
  • すぐに回答を!

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

noname#63196

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

  • 回答数3
  • 閲覧数215
  • ありがとう数2

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

  • ベストアンサー
  • 回答No.2

こんばんは。 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

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

質問者からのお礼

merlionXXさん ご回答ありがとうございます。 大変参考になりました。 On Error GoTo ついても勉強してみます。

関連するQ&A

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

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

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

  • 複数のシートにまたがり、フィルタオプションの設定から値を抽出するマクロ

    複数のシートにまたがり、フィルタオプションの設定から値を抽出するマクロを組んでおります。 表示したくないシート(data,output)を非表示にしたら、エラーが出てしまいました。 非表示シートの状態で処理することはできませんでしょうか。 Sub Macro7() Application.ScreenUpdating = False Sheets("data").Select Columns("A:J").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _ Sheets("マップ").Range("E2:N3"), Unique:=False Columns("A:J").Select Selection.Copy Sheets("output").Select Range("A1").Select ActiveSheet.Paste Application.CutCopyMode = False Selection.Copy Sheets("マップ").Select Range("E5").Select ActiveSheet.Paste Range("H4").Select Sheets("data").Select Application.CutCopyMode = False ActiveSheet.ShowAllData Sheets("マップ").Select End Sub

その他の回答 (2)

  • 回答No.3
  • imogasi
  • ベストアンサー率27% (4558/16316)

>Sheets("DATA").Range("A3").CurrentRegion.AdvancedFilter _ それより上と、ここ以下は何の関係があるの? 関係の無い箇所は省くとか質問には配慮必要 回答者にコードを解読させるのでなく、何をしたいのか、 どういう場合にフィルタで困るのか、質問には文章で説明するぐらいの配慮が必要と思う。 判った人が回答できればよいというものではない。その他の数万人?も読まされる。

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

  • 回答No.1
  • bin-chan
  • ベストアンサー率33% (1403/4213)

ON ERROR GOTO を検索してみてください。 エラー番号で判断する、ということです。

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

関連するQ&A

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

  • EXCEL2003 VBAを表示ロック

    Sheets("DATA")にあるデータを、Sheets("Branch").Range("B2:B20")にあるコード(数字)で順に抽出します。 それをSheets("Form")を複製したシートに貼ります。 複製シートに名前をつけ、保存します。 ここまでは問題なく、以下のVBAでできました。(だいぶ省略しましたが) Sub Make_BrCopy() Dim myCl As Range With Sheets("DATA") For Each myCl In Sheets("Branch").Range("B2:B10") Sheets("Form").Copy Before:=Sheets(1) Sheets(1).Name = myCl.Value .Range("A1:G1").AutoFilter Field:=2, Criteria1:=myCl.Value .UsedRange.SpecialCells(xlCellTypeVisible).Copy Sheets(CStr(myCl.Value)).Range("A1") Sheets(CStr(myCl.Value)).Copy ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & CStr(myCl.Value) & ".xls" ActiveWindow.Close Application.DisplayAlerts = False Sheets(CStr(myCl.Value)).Delete Application.DisplayAlerts = True .ShowAllData Next myCl End With End Sub ところが、少し困ったことがあります。 Sheets("Form")には、ワークシートモジュール、Private Sub Worksheet_Change(ByVal Target As Range) があるのです。 これを複製したワークシートにそのまま必要なのでそうしてあるのですが、できることなるら、VBAを表示ロックさせたいのです。 元のファイルではVBAProjectのロックでそうしているのですが、ワークシートをコピーして作成したあらたなBOOKはVBAを表示にロックにはなっていません。 丸見えです。 どうすればよいでしょうか? Excel2003です。 また、上記のVBAコードになにかご指摘のことなどありましたらそれもあわせて教えてください。

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

  • マクロで実行時1004エラーがでます・・

    Application.CommandBars("Picture").Visible = False Range("D3").Select Selection.AutoFilter Range("D6").Select Range("B4:L360").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Range("D2:E3"), CopyToRange:=Range("B5:L50"), Unique:= _ False Range("N20").Select End Sub どこが悪いのでしょうか? まったく未経験者なので、わかりません。。よろしくお願いします。

  • コマンドボタンでマクロを起動するとエラーになる

    以下のようなコードをツールバーのマクロから起動するようにするとできるのですがコマンドボタンから起動するようにするとエラーになります。なぜでしょうか? Private Sub CommandButton1_Click() Application.ScreenUpdating = False Workbooks.Open "C:\My Documents\b.xls" Windows("b.xls").Activate Columns("A:C").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _ Workbooks("a.xls").Sheets("Sheet2").Range"A1:A3"), CopyToRange:=Columns("E:G"), Unique:=True ~ここでエラー'1004'~ Windows("a.xls").Activate Workbooks("C:\My Documents\b.xls").Close Application.ScreenUpdating = True End Sub

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

  • マクロで”1004”エラー

    初めまして、現在エクセルでマクロを使用している初心者です。本を見ながら自己流でやっているのですが、どうしても問題が解決しないものがありまして質問させていただきました。シート1を”データベース”、シート2を”検索結果”としています。 Sub OutputData() Dim strDate1 As String Dim strDate2 As String Dim StrJouken1 As String Dim StrJouken2 As String strDate1 = Range("AU2").Value strDate2 = Range("AU3").Value StrJouken1 = ">=" & strDate1 StrJouken2 = "<=" & strDate2 Application.ScreenUpdating = False Sheets("検索結果").Activate Cells.Clear With Sheets("データベース") .Range("A2").AutoFilter Field:=3, _ Criteria1:=StrJouken1, Operator:=xlAnd, Criteria2:=StrJouken2 .Range("A2").CurrentRegion.Copy _ Destination:=Sheets("検索結果").Range("A1") .Range("A2").AutoFilter End With Sheets("検索結果").Columns("A:AF").AutoFit Application.ScreenUpdating = True End Sub というコードで最初は問題なかったのですが、急に”実行時エラー1004 RangeクラスのAutofiterメソッドが失敗しました”という表示が出るようになりました。何を直せばよいのか教えを乞いたいのですが・・・

  • VBAの質問(続きです。)

    昨日は、KenKen_SPさんやtaocatさんには、すばやい対応本当にありがとうございました。お陰様で無事解決しました。ところが、実は、うっかりしていまして、あと1つ重要な点をお伺いするのを忘れてしまいました。そこで、もうひとつだけ何卒教えて下さい。 それは、抽出した件数を、MSGBOXで「○○件ありました。」とか表示させたいのですが、因みに、昨日お世話になったVBAは、次のとおりです。 Sub ParamOutputData() Dim strKeyword As String Dim strJouken As String strKeyword = InputBox("検索したい住所の一部を  入力してください。") If strKeyword = "" Then Exit Sub strJouken = "*" & strKeyword & "*" Application.ScreenUpdating = False Sheets("Sheet2").Activate Cells.Clear With Sheets("Sheet1") .Range("A3").AutoFilter Field:=4, _ Criteria1:=strJouken .Range("A3").CurrentRegion.Copy _ Destination:=Sheets("Sheet2").Range("A3") .Range("A3").AutoFilter End With Sheets("Sheet2").Columns("A:F").AutoFit 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

  • VBA空白を除いてコピーが出来ません。ご指導お願いします。

    値のコピー&ペースト(空白を除いてコピー)したいと思っております。 シート1 の A35、D35、I35 をコピー。 シート2 の A2 に貼り付け。 これは、大丈夫です。 シート1 の M2 : O23 をコピー。 シート2 の E2 に貼り付け。 今回の場合ですと、M2 : O13 までに値が入ってます。 ですので、M14 : O23 までが、空白になって記入となってしまいます。 *毎回、値が入る量が違います。 一回のコピーですと、これでもいいのですが、 値を変更して、コピーを続けてしますので、M14 : O23 までが、空白になってM24からのコピーになってしまいます。 空白を除いて、貼り付けしたいのですが、 どうすればいいのかわかりません。 お分かりになる方、ご指導よろしくお願いします。 VBAは以下になっております。 Sub Macro1() ' Application.ScreenUpdating = False Sheets("Sheet1").Range("A35,D35,I35").Copy If Sheets("Sheet2").Range("A2").Value = "" Then Sheets("Sheet2").Range("A2").PasteSpecial Paste:=xlPasteValues Else Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues End If Sheets("Sheet1").Range("M2:O23").Copy If Sheets("Sheet2").Range("E2").Value = "" Then Sheets("Sheet2").Range("E2").PasteSpecial Paste:=xlPasteValues Else Sheets("Sheet2").Range("E" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues End If Application.CutCopyMode = False Application.ScreenUpdating = True End Sub よろしくお願いします。