• ベストアンサー

エクセルVBAでのエラーの対処方法

よろしくお願いします。 A1:1 B1:あ A2:2 B2:い A3:3 B3:う と書いてあるまとめシートと、1、2、3というシートがあるとします。 シート1のA1セルに「あ」、シート2のA1セルに「い」、シート3のA1セルに「う」と書き込まれるように、まとめA列の文字列からシート名を呼び出して書き込むようにVBAを組んでいます。 Dim sht_n As Variant Dim sht_c As Integer i = 7 sht_n = Worksheets("まとめ").Index sht_c = ThisWorkbook.Sheets.Count For sht_n = sht_n + 1 To sht_c Step 1 If Cells(i, 1).Value = "" Then i = i + 1 Else wb = Cells(i, 1).Value Worksheets("まとめ").Cells(i,2).Select Selection.Copy ThisWorkbook.Worksheets(wb).Activate Range("A1").Select Selection.PasteSpecial Paste:=xlValues こんな感じ。 下手なのは分かってます。あと、現在使っているものから書き出しているので間違えてる部分もあるかもしれません。 この状態だと、シート1がない場合にはエラーが出てしまって、そこで終わってしまいます。 まとめシートが空欄の場合はエラーを回避しているのですが、シートがない場合の回避方法が分かりません。 On Error Resume Nextは使わずに、シートがない場合にエラーを回避する方法はありますでしょうか。 分かるかた、よろしくお願いします。

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

  • ベストアンサー
  • Wendy02
  • ベストアンサー率57% (3570/6232)
回答No.5

こんにちは。 >どのように回避すべきかというところに至りたかったので、 繰り返しますが、シートのセルにあらかじめキメウチにする限りは、エラーを承知でコーディングしたほうがよいと思います。ただ、初級の人には、エラートラップは難しいです。失敗を繰り返しながら覚えるのですが。 エラー処理の学習レベルに関しては、以下をご覧ください。 http://vbae.odyssey-com.co.jp/vbae/pro2003.html シート名に数字を使う場合、マクロでシート名を入れて作らない限りは、不明なエラーが発生することがあるので、そのために、本来は、特殊なコードになるはずですが、今回はそういうことはないということで作りました。 '----------------------------- Sub ErrorSample()   Dim mSht As Worksheet   Dim i As Integer   Dim shName As String   Dim sh As Worksheet      Set mSht = Worksheets("まとめ")      For i = 1 To mSht.Range("A65536").End(xlUp).Row     shName = mSht.Cells(i, 1).Value     If shName <> "" Then       On Error Resume Next       Set sh = Worksheets(shName)       If Err.Number = 0 Then         sh.Cells(1, 1).Value = mSht.Cells(i, 2).Value       End If       On Error GoTo 0       Set sh = Nothing     End If   Next i   Set mSht = Nothing End Sub

aa723aa
質問者

お礼

改めてありがとうございます。 大変勉強になりました。 また、リンク先も非常に勉強になっております。 普通にコーディングしているつもりでもエラーはどんどん出てくる有様なので、間違えながら、間違えてるとVBAに怒られながら、上手にコーディングできるようにがんばりたいと思います。

その他の回答 (4)

  • n-jun
  • ベストアンサー率33% (959/2873)
回答No.4

>On Error Resume Nextは使わずに、シートがない場合にエラーを回避する方法はありますでしょうか。 事前にDictionaryオブジェクトにシート名を放り込んでおいて”まとめ”のA列を順に取得し、 Dictionaryにあれば存在するし、なければ存在しないのでそこで処理を分けるとか? On Error Resume Nextを使った方が楽だと思いますけどね。

aa723aa
質問者

お礼

ありがとうございます。 Dictionaryオブジェクトという方法もあるのですね。なるほどです。

  • Wendy02
  • ベストアンサー率57% (3570/6232)
回答No.3

#2の修正 #いずれにしても、エラーは発生しますから、あまり良い方法はないと思います。 あえて、その都度、ループで全シートをチェックすれば、エラーは発生しませんが……。

aa723aa
質問者

補足

ありがとうございます。 実は、かなりの初心者です。 仕事上必要になったこともあり、勉強も兼ねて書いています。 On Error Resume Nextは勉強していく上で知った方法です。また、エラーが出ることも分かった上で作っています。 「勉強」という事で、ただ回避するだけではなく、どのように回避すべきかというところに至りたかったので、このような質問を投げかけました。考えうるエラーに対して何かしらの対策を施したいという気持ちからです。

  • Wendy02
  • ベストアンサー率57% (3570/6232)
回答No.2

こんにちは。 >On Error Resume Nextは使わずに、 なぜ、そのような条件が必要なのでしょうか。 エラートラップが分かって、そうおっしゃっているとは思います。エラートラップを使いこなせられるなら、レベル的には相当に上級クラスだと思います。その上の質問なら、ご自身で考えたほうがよいのではないでしょうか。エラートラップを使わない方法もありますが、いずれにしても、エラーは発生しますから、あまり良い方法はないと思います。 A1:1 B1:あ A2:2 B2:い A3:3 B3:う Worksheets(シート名)が、予め決められているものに対して、ループで名前を探す方法はあっても、私からすれば、初心者でエラートラップの使い方が分からないのか、それとも、わざと制限したコードになるのだと思います。エラートラップを使わない理由自体が分かりません。

  • pkh4989
  • ベストアンサー率62% (162/260)
回答No.1

こんにちは。 コードを変えてみました。ご参考に Sub test()   Dim wR     As Long   Dim c      With Sheets("まとめ")     For wR = 1 To .Range("A" & Rows.Count).End(xlUp).Row '←入力行数を求める       If .Cells(wR, 1) <> "" Then 'シート名が入力されている         For Each c In Worksheets           'シート存在チェック           If c.Name = Trim(.Cells(wR, 1)) Then             '存在する場合のみ設定             Sheets(c.Name).Range("A1") = .Cells(wR, 2)           End If         Next       End If     Next   End With End Sub

aa723aa
質問者

補足

ありがとうございます。 なんとなく理解はできたのですが、これ、このままだと動かなかったんです・・・(すいません。)

関連するQ&A

  • EXCEL VBA 取得したセルの列の最終行

    お客さんからいただいたEXCELフォーマットに沿って、集計ツールを作成していますが 下記でつまってしまいました。 Wb.Worksheets("Sheet1").Cells.Find("実施日").Select Sel_Col = Selection.Column Last_Row = Wb.Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row ※1 For i = Last_Row To 2 Step -1 If Wb.Worksheets("Sheet1").Cells(Sel_Col, i).Value = Day Then ※2 If Wb.Worksheets("Sheet1").Cells(Sel_Col, i).Offset(-5).Value = "A" Then A_count = A_count + 1 ElseIf Wb.Worksheets("Sheet1").Cells(Sel_Col, i).Offset(-5).Value = "B" Then B_count = B_count + 1 ElseIf Wb.Worksheets("Sheet1").Cells(Sel_Col, i).Offset(-5).Value = "C" Then C_count = C_count + 1 End If Else End If Next i まず※1の箇所ですが、Sheet1の実施日と入力されているセルの列番号を取得して その列の最終行を取得したいのですが、上記作成したものですと入力されている列全部の 中での最終行が取得されてしまいます。 この場合、Sel_Col をどのように使えばよろしいでしょうか? 次に※2ですが、※1で取得した列の最終行から1つずつ上に上がりながら 日付が今日であれば、そのセルから5つ左のセルのA、B、Cいずれかを カウントするという造りにしたいと思っています。 実行すると1004エラーでアプリケーション定義、オブジェクト定義のエラーと 出てしまいます。 Wbはset Wbとして開いたブックを定義しています。 DayはDay = Dateで今日の日付を取得しています。 独学で無茶苦茶なコードですが、 どなたか詳しい方、ご教示お願いいたします。

  • 【エクセルVBA】特定のシートのみ検索したい

    VBA勉強中です。 フォルダにある複数のファイル(1ファイル内には複数シートあります)を順番に開けて検索をかけ、条件に合致した行をあるファイルへ転記・集約させるマクロを組みたいと思っています。 (条件は1番左の列が「○」であることです。) ネットや本を参考にしながら組んでみたのですが、「○」がない(シートの)行も転記されてしまい困っています。 (○があるシートは複数シートの内、1シートのみなのですが、○がないシートからも 「○があるシートの○がある行」と同じ行番号の行がが転記されているようです) 組んでみたマクロは以下のとおりです。 ------------------------------------------------ Sub 楕円1_Click() ActiveSheet.Range("A2:H30").ClearContents Dim ans, fn, wb, x, i, n, sh, myPath ans = "○" '条件 myPath = ThisWorkbook.Path & "\" fn = Dir(myPath & "*.xls") '選択したフォルダ内のExcelファイル Do Until fn = "" If fn <> ThisWorkbook.Name Then 'ファイルが当ファイル以外なら Set wb = Workbooks.Open(myPath & fn) '選択したファイルを開きます For Each sh In wb.Worksheets '各シートごとに x = sh.Cells(Rows.Count, 1).End(xlUp).Row '最終行取得 For i = 1 To x '1行目から最終行まで以下を実行します If Cells(i, 1) = ans Then '条件に合致するか検索 n = n + 1 With ThisWorkbook.Sheets("Sheet1") '転記 .Cells(n + 1, 1) = sh.Cells(i, "B") .Cells(n + 1, 2) = sh.Cells(i, "C") .Cells(n + 1, 3) = sh.Cells(i, "D") .Cells(n + 1, 4) = sh.Cells(i, "E") .Cells(n + 1, 5) = sh.Cells(i, "F") End With End If Next i Next sh wb.Close (False) '選択したファイルを閉じる End If fn = Dir() '次のファイルを検索 Set wb = Nothing Loop '繰り返し --------------------------------------------------------- このマクロでは各ファイルの全てのシートを検索していると思うのですが、 全シートを検索していることが問題でしょうか? 検索したいデータは特定のシートにのみ存在するので(全ファイル同じ名前のシートです) 特定のシートのみ検索してくれればそれで良いのですがどう変更すればよいかわかりません。 「For Each sh In wb.Worksheets '各シートごとに」 色々と調べてここを変更してみたのですが 何れもエラーとなり上手くいきませんでした。 どなたか上手く直す方法を教えて下さい。 宜しくお願いします。

  • EXCELのVBAについて教えてください。

    演習1というシートの(1,1)のセルの値と(1,2)のセルの値を入れ替えるプログラムを作成したいので すがエラーが出て出来ません。コードは下記の様に書きました。 Sub 演習1() Dim sheetobj As Worksheet Dim a As Integer Set sheetobj = ThisWorkbook.Worksheets("演習1") With sheetobj a = .Cells(1, 1) .Cells(1, 1) = .Cells(1, 2) .Cells(1, 2) = a End With End Sub プログラミング自体が本を読んでも分かりません。 宜しければ小学生に教えるように文を訳してくれませんか?

  • VBA シート指定の結合

    あるフォルダ配下に複数のエクセルがあります。 これを以下のように1つのシートに統合したいのです。 >For Each sh In wb.Worksheets を >For Each sh In wb.Worksheets("Sheet2") としましたが,エラーで動きませんでした。 いろいろやってみたり調べましたが頓挫しております。 よろしくお願い致します。 条件  科目名(A科目   B科目  C科目)のタイトル部分は不要  フォルダ配下にあるすべてのエクセルファイル内のある特定のシートの内容を統合したい。シート名は共通のものをつけています。 (ファイル内の全てのシートを結合する方法は分かったのですが,ある特定のシートを指定しての統合ができません。) <1.xls> (sheet1)  A科目   B科目  C科目 390,200  426,200  801,600 (sheet2)  A科目   B科目  C科目 5,000   6,000  7,000 <2.xls> (sheet1)  A科目   B科目  C科目 140,500  333,200   1,400 (sheet2)  A科目   B科目  C科目 8,000   9,000   10,000 ↓ <統合.csv> 390,200  426,200  801,600 140,500  333,200   1,400 *以下,現在までにできたVBA Sub Test() Dim fn, wb, x, i, n, sh, myPath myPath = ThisWorkbook.Path & "\" fn = Dir(myPath & "*.xls") '選択したフォルダ内のExcelファイルを検索します Do Until fn = "" '全て検索し終えると、fn = Empty となるので、その間以下を実行します If fn <> ThisWorkbook.Name Then 'ファイルが自分以外なら Set wb = Workbooks.Open(myPath & fn) '選択したファイルを開きます For Each sh In wb.Worksheets '各シートごとに x = sh.Cells(Rows.Count, 1).End(xlUp).Row '最終行取得 For i = 2 To x '2行目から最終行まで以下を実行します n = n + 1 With ThisWorkbook.Sheets("Sheet1") '転記 .Cells(n, 1) = sh.Cells(i, "A") .Cells(n, 2) = sh.Cells(i, "B") .Cells(n, 3) = sh.Cells(i, "C") End With Next i Next sh wb.Close (False) '選択したファイルを閉じる End If fn = Dir() '次のファイルを検索 Set wb = Nothing Loop '繰り返し ThisWorkbook.Sheets("Sheet1").Copy Application.Dialogs(xlDialogSaveAs).Show Arg1:="統合.csv", Arg2:=6 End Sub

  • Excel VBA グラフ作成のときのエラー

    VBA初心者です。Excel2003を使っています。 Sheet1に作りたいグラフがあります。 データは下記のとおりです。 ActiveChart.SeriesCollection(1).Name = Cells(a_data, "A")のところで、「実行時エラー13 型が一致しません」とエラーがでます。 不思議なのは、昨日は動いていたのです。 なぜ、エラーが出るようになったのかわかりません。 ご教授よろしくお願いします。 A B 1 a 1 2 2 3 3 4 4 5 5 6 b 6 7 7 8 8 9 9 10 10 11 c 11 12 12 13 13 14 14 15 15 Sub test() Wrow = Worksheets("sheet1").Cells(Rows.Count, "A").End(xlUp).Row For i = 1 To Wrow If Worksheets("sheet1").Cells(i, "A").Value = "a" Then a_data = Worksheets("sheet1").Cells(i, "A").Row ElseIf Worksheets("sheet1").Cells(i, "A").Value = "b" Then b_data = Worksheets("sheet1").Cells(i, "A").Row ElseIf Worksheets("sheet1").Cells(i, "A").Value = "c" Then c_data = Worksheets("sheet1").Cells(i, "A").Row ElseIf Worksheets("sheet1").Cells(i, "A").Value = "d" Then d_data = Worksheets("sheet1").Cells(i, "A").Row End If Next Sheets("sheet1").Select Range(Cells(a_data, "B"), Cells(b_data, "B")).Select ActiveSheet.ChartObjects.Add(30, 10, 500, 200).Select ActiveChart.ChartType = xlLineMarkers ActiveChart.SetSourceData Source:=Sheets("sheet1").Range(Cells(a_data, "B"), Cells(b_data - 1, "B")), PlotBy:=xlColumns ActiveChart.Location where:=xlLocationAsObject, Name:="sheet1" Sheets("sheet1").Select ActiveChart.Axes(xlCategory, xlPrimary).CategoryType = xlAutomatic ActiveChart.SeriesCollection.NewSeries ActiveChart.SeriesCollection.NewSeries ActiveChart.SeriesCollection.NewSeries ActiveChart.SeriesCollection(1).Name = Cells(a_data, "A") ←エラーがでます。 ActiveChart.SeriesCollection(2).Values = Range(Cells(b_data, "B"), Cells(c_data, "B")) ActiveChart.SeriesCollection(2).Name = Cells(b_data, "A") ActiveChart.SeriesCollection(3).Values = Range(Cells(c_data, "B"), Cells(d_data, "B")) ActiveChart.SeriesCollection(2).Name = Cells(c_data, "A") End Sub

  • Excel VBA 指定シートの取込

    こんにちは。 ExcelのVBAを使用して、異なるBookのシートを取込みたいのですが、 シートが無かった場合の処理方法がわかりません。 現在のコードは下記の様になっております。 With Workbooks.Open"BOOK1.xls" .Worksheets("Sh1").Cells.Copy ThisWorkbook.Sheets("Sheet1").Range("A1") .Worksheets("Sh2").Cells.Copy ThisWorkbook.Sheets("Sheet2").Range("A1") .Worksheets("Sh3").Cells.Copy ThisWorkbook.Sheets("Sheet3").Range("A1") .Close End With Book1に指定したシートが無い場合、何もしないようにしたいのですが、 どの様に書き換えれば宜しいでしょうか? よろしくお願いします。

  • excel vbaのエラー原因について

    よろしくお願いします。初心者で勉強中です。以下のコードを作成してみましたがエラーが出ます。いろいろ調べてみましたが解決策がわからないので、教えて頂ければと思います。 ・シートは31シートあります(1番左のシート名は"初期設定"、2番目は 1日、3番目は2日と・・・、順に30日まであります。) 。 ・やりたい事。 ・2番目シートの(A1からA10)までをコピーし、1番目シートのA2にはりつける。3番目シートの(A1からA10)までをコピーし、1番目シートの先ほど貼り付けたデータの1つ下の行にはりつける・・・順に30日までのデータをすべて1番目シートに貼り付けたいと思っています。 ・"初期設定シート"の1行目には文字が入っているので、データの貼り付けは2行目からにする予定です ・作ったコード Sub 練習() Dim maxrow As Long Dim i As Long maxrow = Sheets(1).Range("a1").End(xlDown).Row For i = 2 To 31 Sheets(i).Select Sheets(i).Range("A1", "A10").Select Selection.Copy Worksheets(1).cells(maxrow+1,1) Next i End Sub ・F8で1文ずつ確認すると、Selection.Copy Worksheets(1).cells(maxrow+1,1) を実行したときに、「実行時エラーがでます」。 EXCEL2000を使用しています。 よろしくお願いします。

  • VBAの質問です

    1つめの質問。 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"), _のままではダメなのでしょうか。 2つめの質問。 ある行に何もデータがないときに限りその行を削除するというようなマクロはどうやればいいのでしょうか。出来たとしてもシートの下の方が全部消えてしまうので,適用する範囲を指定する必要がありそうですが。 よろしくお願い致します。

  • VBA 初心者

    sheet1から、sheet2データを検索して抽出する練習をしているのですがerror"1104"が表示されます、なぜなのか分からないので投稿しました、よろしくお願いします。 sub test() dim sh1 as worksheets dim sh2 as worksheets dim  i  as  integer set sh1 = thisworkbook.worksheets("sheet1!") set sh2 = thisworkbook.worksheets("sheet2!") b = userform1.textbox1 for i = 1 to 10 sh1 .cells(i,2) = b b = b+1 x = sh1.cells(1,2) sh1.cells(i,3).value = worksheetfunction.vlookup(x,sh2.range("a1:d500"),2,false) next i end sub

  • EXCEL VBA VloopUPエラー

    お世話になります。 EXCEL VBAでVlookupを動かそうとしていますが、エラーが出てうまく動きません。 以下やりたいことと、エラーメッセジとなります。 【やりたいこと】 「生販在庫推移表」シートにある日付(Cells(1,j).Value)をキーにして、別シートの「日別商品別集計」(このシートの1列目は日付になっています)のある列(sno)の値を「生販在庫推移表」シートのあるセル(Cells(i,j).Value)に持ってきたいのです。 【エラーになっているロジック】 Worksheets("生販在庫推移表").Cells(i, j).Value = Application.WorksheetFunction.VLookup(Worksheets("生販在庫推移表").Cells(1, j).Value, Worksheets("日別商品別集計").Range("A1:BZ5000"), sno, False) 【エラーメッセージ】 実行時エラー'1004' WorksheetFunction クラスのVLookupプロパテイを取得できません。 どなたか良きアドバイスをご教授いただけますでしょうか。 よろしくお願い致します。

専門家に質問してみよう