Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


8810 / 13644 ツリー ←次へ | 前へ→

【31036】Excel2003 VBAにおけるエラー回避 Maybe 05/11/9(水) 16:58 質問[未読]
【31038】Re:Excel2003 VBAにおけるエラー回避 Jaka 05/11/9(水) 17:21 回答[未読]
【31041】Re:Excel2003 VBAにおけるエラー回避 Hirofumi 05/11/9(水) 20:39 回答[未読]
【31042】Re:Excel2003 VBAにおけるエラー回避 でれすけ 05/11/9(水) 20:42 回答[未読]

【31036】Excel2003 VBAにおけるエラー回避
質問  Maybe  - 05/11/9(水) 16:58 -

引用なし
パスワード
   初めて投稿する者です。
Excel2003上で実行する以下マクロにおけるエラー回避についてお尋ねします。

1.マクロの概要

ABC各シートの所定セルを選択/コピーして、既存シートXの所定セルにペーストします。
その際、ABC各シートが存在しない場合のエラー(番号"9")を回避させます。

2.問題の現象

ABC3枚のシートのうち何れか1枚が存在しない場合は正常にエラー回避されるのですが、2枚以上のシートが存在しない場合、最初のエラー回避は正常、2回目のエラーは回避されません。

 ex.1 ABC全てが存在しない場合、Bを選択するときにエラーとなります。

 ex.2 ABが存在しない場合はBで、同じくBCの場合はCで、同じくACの場合はCでエラーとなります。


上記現象から、同一エラーの複数回避は不可となっているようです。
今回のケースで、全てのエラーを回避する手段(コーディング)につきご教示ください。

以上、よろしくお願いいたします。


Sub Test()

  On Error GoTo Skip01
  Sheets("A").Select
  Range("B11").Select
  Selection.Copy
  Range("E1").Select
  Sheets("X").Select
  Range("F8").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

Skip01:
  On Error GoTo Skip02
  Sheets("B").Select
  Range("B11").Select
  Application.CutCopyMode = False
  Selection.Copy
  Range("E1").Select
  Sheets("X").Select
  Range("G8").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

Skip02:
  On Error GoTo Skip03
  Sheets("C").Select
  Range("B11").Select
  Application.CutCopyMode = False
  Selection.Copy
  Range("E1").Select
  Sheets("X").Select
  Range("H8").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

Skip03:
  On Error GoTo 0

End Sub

【31038】Re:Excel2003 VBAにおけるエラー回避
回答  Jaka  - 05/11/9(水) 17:21 -

引用なし
パスワード
   Sub Test()
  On Error Resume Next
  Set Sh = Sheets("A")
  If Err = False Then
    Sheets("A").Range("B11").Copy
    Sheets("X").Range("F8").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
                SkipBlanks:=False, Transpose:=False
  End If
  Err.Clear

  Set Sh = Sheets("B")
  If Err = False Then
    Sheets("B").Range("B11").Copy
    Sheets("X").Range("G8").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
                SkipBlanks:=False, Transpose:=False
  End If
  Err.Clear

  Set Sh = Sheets("C")
  If Err = False Then
    Sheets("C").Range("B11").Copy
    Sheets("X").Range("H8").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
                SkipBlanks:=False, Transpose:=False
  End If
End Sub

【31041】Re:Excel2003 VBAにおけるエラー回避
回答  Hirofumi  - 05/11/9(水) 20:39 -

引用なし
パスワード
   ゴメン、再投稿

Option Explicit

Sub Test()
  
  Dim i As Long
  Dim vntSheet As Variant
  Dim wksMark As Worksheet
  
  vntSheet = Array("A", "B", "C")

  For i = 0 To 2
    If SheetExist(vntSheet(i), wksMark) Then
      With wksMark
        .Select
        .Range("E1").Select
        Sheets("X").Range("F8").Offset(i).Value _
                  = wksMark.Range("B11").Value
      End With
    End If
  Next i
  
  Sheets("X").Activate
  
  Set wksMark = Nothing
  
End Sub

Private Function SheetExist(vntName As Variant, _
              wksMark As Worksheet) As Boolean

  Dim blnExit As Boolean
  
  For Each wksMark In Worksheets
    If StrComp(wksMark.Name, vntName) = 0 Then
      blnExit = True
      Exit For
    End If
  Next wksMark
  
  SheetExist = blnExit
  
End Function

【31042】Re:Excel2003 VBAにおけるエラー回避
回答  でれすけ  - 05/11/9(水) 20:42 -

引用なし
パスワード
   こんばんは。

最近、他の場所でおなじようなことを書きました。

  注意しなくてはならないことは、

   On Erorr Gotoはエラー発生時にエラー処理ルーチンに
   処理をジャンプさせるものであることと、

   On Erorr Goto でジャンプした先(エラー処理ルーチン)では、
   エラー処理が有効にならないことです。

   エラー処理部でのエラーはトラップできません。

   エラー処理ルーチンの終了後に、実行を再開するには、
   Resume ステートメントを使わなくてはなりません。

まとめると、
 
 On Error Goto でジャンプすると、エラー処理部の中にいることになり、
 Resumeステートメントでエラー処理部から戻るまで、
 エラートラップが有効に成らない。
 (エラートラップの無限ループに陥らないための配慮と思って下さい。)

簡単になおすと、以下。

Sub Test()

On Error GoTo Err_Handeler1
  Sheets("A").Select
  Range("B11").Select
  Selection.Copy
  Range("E1").Select
  Sheets("X").Select
  Range("F8").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

Skip01:
  On Error GoTo Err_Handeler2
  Sheets("B").Select
  Range("B11").Select
  Application.CutCopyMode = False
  Selection.Copy
  Range("E1").Select
  Sheets("X").Select
  Range("G8").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

Skip02:
  On Error GoTo Err_Handeler3
  Sheets("C").Select
  Range("B11").Select
  Application.CutCopyMode = False
  Selection.Copy
  Range("E1").Select
  Sheets("X").Select
  Range("H8").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

Skip03:

  On Error GoTo 0
  
  Exit Sub

Err_Handeler1:
 Resume Skip01

Err_Handeler2:
 Resume Skip02

Err_Handeler3:
 Resume Skip03

End Sub


もうちょっと短くすると以下。

Sub Test2()

Dim ShList As Variant
ShList = Array("A", "B", "C")

For i = 0 To 2
 On Error GoTo Err_Handler
  Sheets(ShList(i)).Range("B11").Copy
 On Error GoTo 0
 Sheets("X").Cells(8, i + 6).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
skip:
Next

Exit Sub

Err_Handler:
 Resume skip
 
End Sub

8810 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free