VBAでシートが存在するか確認し、処理を行うマクロの作成方法

このQ&Aのポイント
  • VBAでシートが存在するか確認し、処理を行うマクロの作成方法について教えてください。
  • 質問者さんが試したVBAコードでは、シートが2枚不足すると「インデックスが有効範囲にありません」とのエラーメッセージが表示されます。1枚不足の場合は正常に処理されます。この理由と対策を教えてください。
  • お礼と質問の文章を作成して、シートが存在するか確認し、処理を行うVBAマクロの作成方法について教えてください。
回答を見る
  • ベストアンサー

お世話になります

お世話になります シートが存在する時だけ処理するマクロを組みたいです。 そこで下記の通り作ってみましたが、上手に動きません。   Sub マクロ()      Dim mychksht As Worksheet     1:      On Error GoTo 2      Set mychksht = Sheets("1")      MsgBox "1 あります"     2:      On Error GoTo 3      Set mychksht = Sheets("2")      MsgBox "2 あります"     3:      On Error GoTo 4      Set mychksht = Sheets("3")      MsgBox "3 あります"     4:      On Error GoTo 5      Set mychksht = Sheets("4")      MsgBox "4 あります"     5:      MsgBox "終了します"    End Sub シートが2枚不足すると「インデックスが有効範囲にありません」とのメッセージが出ます。 ※1枚不足しているだけなら正常に処理します。 分かる方いらっしゃいますか? 理由と対策をお教え頂ければ幸いです。   

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

  • ベストアンサー
  • jcctaira
  • ベストアンサー率58% (119/204)
回答No.1

エラーで「On Error GoTo」になった場合、エラーを一度リセット(Resume)する必要があります。 よって今回は2度目のエラー時にResume命令を行わなかったのでエラーメッセージが表示されたようです。 対応は以下のようにすれば良いですが、もうちょっとわかりやすいプログラムにした方が良いかと思います。 【OKERAUMIさんのプログラムを単純に変更】 Sub マクロ()   Dim mychksht As Worksheet 1:   On Error GoTo err2   Set mychksht = Sheets("1")   MsgBox "1 あります" 2:   On Error GoTo err3   Set mychksht = Sheets("2")   MsgBox "2 あります" 3:   On Error GoTo err4   Set mychksht = Sheets("3")   MsgBox "3 あります" 4:   On Error GoTo err5   Set mychksht = Sheets("4")   MsgBox "4 あります" 5:   MsgBox "終了します"   Exit Sub err2: Resume 2 err3: Resume 3 err4: Resume 4 err5: Resume 5 End Sub 【On Error Resume Next で行った場合(処理後にエラーがないかを確認)】 Sub マクロ()   Dim mychksht As Worksheet   On Error Resume Next   Err.Clear   Set mychksht = Sheets("1")   If Err.Number = 0 Then MsgBox "1 あります"      Err.Clear   Set mychksht = Sheets("2")   If Err.Number = 0 Then MsgBox "2 あります"      Err.Clear   Set mychksht = Sheets("3")   If Err.Number = 0 Then MsgBox "3 あります"      Err.Clear   Set mychksht = Sheets("4")   If Err.Number = 0 Then MsgBox "4 あります"      Err.Clear   Set mychksht = Sheets("5")   If Err.Number = 0 Then MsgBox "5 あります" End Sub 【On Error Resume Next で シート名を"1"~"5"で繰り返した場合】 Sub マクロ()   Dim I    As Integer   Dim mychksht As Worksheet   On Error Resume Next   For I = 1 To 5     Err.Clear     Set mychksht = Sheets(CStr(I))     If Err.Number = 0 Then MsgBox I & " あります"   Next I End Sub

OKERAUMI
質問者

お礼

ありがとうございます。 教えて頂いた方法で上手にいきました。

関連するQ&A

  • インプットボックスで選択したシートをselectした

    先日ここで、インプットボックスを使ったシート間コピーを教えて頂きました。 その中で、コピー先を選択した後にそのシートがselectされた状態にして、ペースト確認のmsgboxを表示したいのですが、どの様したらいいのでしょうか? Sub コピー() Dim CopyArea As Range Dim PasteArea As Range On Error GoTo ErrorHandler Dim a As String Set CopyArea = Application.InputBox(prompt:= _ "コピー元を指定して下さい", Title:="コピー元", Type:=8) BUCK: Set PasteArea = Application.InputBox(prompt:= _ "貼り付け先を指定して下さい", Title:="貼り付け先", Type:=8) Sheets(****).Select If MsgBox("貼り付けます。" & Chr(10) & "よろしいですか?キャンセルで再選択。", vbOKCancel + vbQuestion) = vbOK Then CopyArea.Copy PasteArea Else GoTo BUCK End If Exit Sub ErrorHandler: MsgBox "処理が取り消されました" End Sub

  • EXCEL マクロにて

    EXCELにて質問があります 別シートのピンクという文字列をB列から探すマクロを作成しました Private Sub CommandButton1_Click() Set aaa = Sheets("sheet1写真").Columns(2).Find("ピンク").Address(False, False) MsgBox aaa Application.Goto Sheets("Sheet1写真").Range(aaa) End Sub このマクロを実行しても型が一致しませんと言うエラーが出てしまいます 何がいけないのかさっぱりわかりませんどうかご教授お願いします

  • エクセル/マクロ Exit Subが実行されない

    エクセルマクロの質問です。エクセルのヴァージョンは2000です。 あるシートをコピーして新シートに任意の名前を付けるマクロを作っています。ユーザーフォームの中に一つのテキストボックス(新シートの名前入力用)と二つのコマンドボタンを設置し一つは実行ボタン、もう一つはキャンセルボタンとしました。 QNo.6367227でエラー処理に関する質問をさせていただきましたが、こちらは見事に解決していただきました。 今回の質問はExit Subに関する質問です。 If構文で、条件文1が真であればシートをコピーして名前を変更、フォームを閉じるという処理を目指しています。 If 条件 Then ~ 処理 Exit Sub という形を作って試してみたのですが、処理後にExit Subが実行されません。Exit Subの前にメッセージボックスを挿むとメッセージは表示されましたが、やはりExit Subにはたどり着けませんでした。 すごく初歩的な事で恥ずかしいのですが、Exit Subが実行されない理由と解決法をご教示いただけると助かります。よろしくお願いします。 Private Sub CommandButton1_Click() Dim NewSheetName As String NewSheetName = TextBox1.Value On Error Resume Next Sheets("Summary").Name = NewSheetName If Err.Number = 0 Then Sheets(NewSheetName).Copy before:=Sheets(NewSheetName) ActiveSheet.Name = "Summary" MsgBox ("Task Completed!") ExitSub Else MsgBox "Invalid name!" End If On Error GoTo 0 End Sub

  • 指定シートの有無を確認

    指定したシートの有無を確認するVBAを作っているのですがうまく作動しません。 Sub dummy() Dim dummy Dim sheetname As String sheetname = Sheets("入力").Cells(1, 1).Value '←『入力』というシートのセルA1と同じ値のシート名 On Error Resume Next Set dummy = sheetname If Err.Number = vbnomal Then flag = True On Error GoTo 0 If flag Then Msgbox "シートがあります" Else Sheets("原紙").Copy before:=Sheets(1) Worksheets(1).Name = sheetname End Sub 補足:入力というシートのA1に値が入っており、その値と同じシートがあればメッセージが出る、無ければ『原紙』というシートをコピーしてコピーしたシートのタブにA1の値を表示する

  • エクセル/マクロ エラー処理がうまくいきません

    エクセルマクロの質問です。エクセルのヴァージョンは2000です。 シートをコピーして新シートに任意の名前を付けるマクロを作っています。 ユーザーフォームの中に一つのテキストボックス(新シートの名前入力用)と 二つのコマンドボタンを設置し一つは実行ボタン、もう一つはキャンセルボタンとしました。 テキストボックスに不正な名前(空白、記号、すでに存在するシート名)が入力された状態で 実行ボタンを押すと新シートは作成されず、メッセージボックスで実行できない旨が表示され、 入力フォームに戻るという感じにしようと思っています。 エラー処理には下記の通りOn Errorステートメントを試してみました。が、どうもうまくいきません。 エラーが出ても新しいシートが作成されてしまい、その後にメッセージボックスが出てしまいます。 正しいエラー処理の仕方をご教示頂けると幸いです。どうぞよろしくお願いします。 Private Sub CommandButton1_Click() Dim NewSheetName As String NewSheetName = TextBox1.Value On Error GoTo Err1 Sheets("Summary").Select Sheets("Summary").Copy After:=Sheets("Summary") ActiveSheet.Name = NewSheetName Exit Sub Err1: MsgBox "Invalid name"    Exit Sub End Sub

  • Select Case について

    Sub dummy() Dim Dummy As Worksheet Dim SheetName As String Dim i As Integer Dim GEN As Long Dim OTA As Long With Sheets("入力") '3行目~22行目まで For i = 3 To 22 SheetName = Sheets("入力").Range("D3").Value On Error Resume Next Set Dummy = Sheets(SheetName) 'もしシートがあれば・・・ If Err.Number = 0 Then Select Case .Cells(i, 14).Value Case "TK-001" OTA = Sheets("TK-001").Range("B65536").End(xlUp).Row + 1 Sheets("TK-001").Range("B" & OTA).Value = .Cells(i, "H").Value Sheets("TK-001").Range("I" & OTA).Value = .Cells(i, "I").Value Sheets("TK-001").Range("F" & OTA).Value = .Cells(i, "K").Value Sheets("TK-001").Range("G" & OTA).Value = .Cells(i, "L").Value Sheets("TK-001").Range("J" & OTA).Value = .Cells(i, "M").Value End Select 'シートが無ければ・・・ Else '原紙をコピーする Sheets("原紙").Copy BEFORE:=Sheets(1) 'シートの名前を市場コードにする Sheets(1).Name = SheetName End If Next End With On Error GoTo 0 End Sub 上記の通りマクロを組みましたが、以下の事を行うのに悩んでいます。 (1)Select Case が100通りあるのですが、全てCaseを入れるのではなく  もっと簡単な方法はありますか?  ※『リスト』シートを作っており、B1~B100までcaseになるコードが入力されています。  例:   B    1  TK-001    2  TK-002    3  TK-003        ・        ・        ・   100   TK-100 というシートを作っています。 (2)今のマクロではどんな値でもシートがなければシートを作ってしまう状態ですが、  もし『リスト』シートの中に値があればシートを作る、無ければ作らないというマクロは可能ですか  

  • マクロを使って・・・

    シート1に入力したデータをシート2にコピーするいうマクロを作りました。 シート2にコピーはできるのですが 例えば、そのデータを消して再度新しいデータを入れていきたいと思い エクセル左上のシート全体を選択して「Delete」を押すと 会社のエクセル(2003?)は中断モードがどーのこーのとエラー画面が出て マクロが黄色になって、前に進めません。 やり方が決まっているのでしょうか? コピーした行全体を選択して右クリック「削除」とすると エラー画面が出ません。 やり方など決まっているのでしょうか? ↓がんばって作ったマクロです Sub 正方形長方形4_Click() Call macro01 Call macro02 End Sub Sub macro01() Dim ws1 As Worksheet, ws2 As Worksheet Dim x As Long, y As Long Set ws1 = Sheets("Sheet1") Set ws2 = Sheets("Sheet2") x = ws2.Cells(Rows.Count, "b").End(xlUp).Row + 1 y = ws1.Cells(Rows.Count, "b").End(xlUp).Row ws1.Cells(21, "b").Resize(y, 9).Copy ws2.Cells(x, "B").PasteSpecial Paste:=xlPasteValues  ←この行が黄色になります Application.CutCopyMode = False End Sub Sub macro02() Worksheets("Sheet1").PrintOut End Sub

  • Private sub の使い方

    Private Sub Worksheet_Activate() Dim ANS As Integer ANS = MsgBox("Bをクリアしてもいいですか?", _ vbYesNo + vbInformation, "クリア実行") If Sheets("B").Range("D6").Value <> "" Then Select Case ANS Case vbYes Sheets("営業確認").Range("D6:E1000").Select Selection.ClearContents Sheets("入力").Select MsgBox "クリアしました" Case vbNo MsgBox "キャンセル" End Select Else End If End Sub 質問 『A』のシートを開いた時に『B』のシートのD6に値があれば、MsgBoxを出すようにしたく上記のマクロを組みましたが、値が無くてもMsgBoxが表示されてしまいます。 どこがおかしいのかアドバイスをお願いします。

  • VBAを始めたばかりです。

    VBAを始めたばかりです。 下記でエラー「オブジェクトが必要です」が出ます。 何故ですか。 Sub A_Sample048() Dim mySht1 As Object Dim mySht2 As Worksheet '準備ここまで Set mySht1 = ActiveSheet If mySht1.Type = xlWorksheet Then Set mySht2 = mySht1 MsgBox mySht2.Name Else MsgBox "最前面のシートはワークシートではありません" End If Set mySht1 = Nothing 'オブジェクトの解放 Set mySht2 = Nothing End Sub よろしくお願いします。

  • excelマクロで新しいシート(シート名 yyyymmdd)を作成したい

    質問させてください。 excelマクロで新しいシート(シート名 yyyy/mm/dd)を作成したいと思っています。 以下のようにマクロを作成したのですが、エラーが出てしまいます。 本件について対応がお分かりになられる方教えていただけないでしょうか。 -------------------------------------- Sub 集計開始_Click() '宣言開始 Dim newsheet As Worksheet 'シート追加 Set newsheet = Worksheets.Add today = Date MsgBox today 'テスト用 'シート名記入 With newsheet .Name = Date ←【ここでエラーがでてしまいます】 End With End Sub -------------------------------------- 大変お手数をお掛けいたします。 宜しくお願い致します。

専門家に質問してみよう