ExcelVBA エラー処理で2回目の同一エラーは

質問

こんにちは。

EcxelVBA初心者です。
セルD8～D10の値をCP44～CP100の値と比較し、一致したら8～10行目のそれぞれのセルに記入する際、
CP44～CP100に一致しない場合（エラー91）、エラー処理でメッセージを表示し、次の比較に進みたくてGOTOを使用していますが、
一度目のエラーはできるのに、二度目のエラーでは「実行時エラー91」が表示されてしまいます。
なぜ、一度目と同じようにエラー処理でメッセージ表示、次の比較に勧めないのでしょうか？

よろしくお願いします。

Sub test()

Dim i As Integer
Dim lng As Long

i = 8

lng = 10

On Error GoTo D_Error

i = 8

Cells(i, "D").Value = StrConv(Cells(i, "D").Value, vbUpperCase) '半角小文字は半角大文字に修正

strType = Cells(i, "D").Value

For i = 8 To lng

Cells(i, "D").Value = Trim(StrConv(Cells(i, "D").Value, vbUpperCase)) '半角小文字は半角大文字に修正し、余分なスペースも取る

strType = Cells(i, "D").Value

If Len(Trim(Cells(i, "D").Value)) = 0 Then ' D列のデータがなければ次の行へ

GoTo BBB

End If

intStr = 0

Cells(i, "D").Select

strType = Cells(i, "D").Value

intStr = InStr(strType, "-") 'ハイフンの位置で調べる

If intStr = 0 Then 'ハイフンがなければ、あいまい検索で文字列を探す

Set rngTarget = Range("CP44:CP100").Find(What:=strType, lookat:=xlPart)

intTarget = rngTarget.Row

Cells(i, "AE").Value = Cells(intTarget, "CR").Value
Cells(i, "AF").Value = Cells(intTarget, "CS").Value
Cells(i, "AG").Value = Cells(intTarget, "CT").Value

Else 'ハイフンがあれば、「(」カッコの有無を調べてから、「-」前の文字を完全一致で探す

If Mid(strType, intStr - 1, 2) = "(-" Then
strType = Left(strType, intStr - 1 - 1)

Else
strType = Left(strType, intStr - 1)
End If

Set rngTarget = Range("CP44:CP100").Find(What:=strType, lookat:=xlWhole)

intTarget = rngTarget.Row

Cells(i, "AE").Value = Cells(intTarget, "CR").Value
Cells(i, "AF").Value = Cells(intTarget, "CS").Value
Cells(i, "AG").Value = Cells(intTarget, "CT").Value

End If

BBB:

Next i

D_Error:

If Err.Number = 91 Then

If i > lng Then
GoTo AAA
End If

MsgBox "CP列に該当する型式がありません。" & Chr(13) _
& Chr(13) _
& "　　型式があるものには「-」を使用してください。" & Chr(13) _
& " それ以外はCP44～CP100にデータを入力してください。"

ActiveSheet.Cells(i, "D").Interior.ColorIndex = 3

GoTo BBB

Else

GoTo AAA

End If

AAA: 'D8から下にデータがない場合

Set rngTarget = Range("CP44:CP100").Find(What:=strType, lookat:=xlPart) '完全一致の解除

Range("D8").Select

End Sub

回答No.2

30246kiku · ベストアンサー

以下雰囲気で（語彙・言葉等あっていないかも・・・）

処理が進む中で
・エラーを検知して、エラー処理に飛んでくれる制御Aと
・エラーを検知して飛んできた所で処理する間の制御B
制御Bに居る限り、さらにエラーが発生すると、そのままエラーが表示されるようになります。
この制御Bから制御Aに復帰するものが Resume 記述です。
制御Aに復帰後、またエラーが発生すると、制御Bに移行してくれます。

Resume せずに Goto とかで、いろんなところから処理を続けても、
制御Bから抜け出した事にはなりません。
Resume の記述の仕方はいろいろあるので、ヘルプででも確認してください。

こんな感じで、わかるでしょうか・・・

空白行多々、等々で結構読みにくい VBA 記述ですね。
極力エラーを起こさない記述に変更し、GoTo を排除・・・
以下に雰囲気で変更してみました（あくまで雰囲気です：未検証）

Public Sub Samp1()
　　Dim rngTarget As Range
　　Dim i As Long, lng As Long
　　Dim strType As String, intStr As Long
　　Dim vA As Variant, v As Variant

　　vA = Array("(-", "-")

　　lng = 10
　　For i = 8 To lng
　　　　With Cells(i, "D")
　　　　　　.Interior.ColorIndex = xlNone
　　　　　　strType = StrConv(Trim(.Value), vbUpperCase)
　　　　　　.Value = strType
　　　　End With
　　　　If (Len(strType) > 0) Then
　　　　　　For Each v In vA
　　　　　　　　intStr = InStr(strType, v)
　　　　　　　　If (intStr > 0) Then
　　　　　　　　　　strType = Left(strType, intStr - 1)
　　　　　　　　　　Exit For
　　　　　　　　End If
　　　　　　Next
　　　　　　On Error Resume Next
　　　　　　Set rngTarget = Nothing
　　　　　　With Range("CP44:CP100")
　　　　　　　　If (intStr = 0) Then
　　　　　　　　　　Set rngTarget = .Find(What:=strType, Lookat:=xlPart)
　　　　　　　　Else
　　　　　　　　　　Set rngTarget = .Find(What:=strType, Lookat:=xlWhole)
　　　　　　　　End If
　　　　　　End With
　　　　　　On Error GoTo 0
　　　　　　If (rngTarget Is Nothing) Then
　　　　　　　　Cells(i, "D").Interior.ColorIndex = 3
　　　　　　　　MsgBox "CP列に該当する型式がありません。" & Chr(13) _
　　　　　　　　　　& Chr(13) _
　　　　　　　　　　& "　　型式があるものには「-」を使用してください。" & Chr(13) _
　　　　　　　　　　& " それ以外はCP44～CP100にデータを入力してください。"
　　　　　　Else
　　　　　　　　Cells(i, "AE").Resize(, 3).Value = _
　　　　　　　　　　Cells(rngTarget.Row, "CR").Resize(, 3).Value
　　　　　　End If
　　　　End If
　　Next
End Sub

>　　On Error Resume Next
>　　Set rngTarget = Nothing
>　　With Range("CP44:CP100")
>　　　　If (intStr = 0) Then
>　　　　　　Set rngTarget = .Find(What:=strType, Lookat:=xlPart)
>　　　　Else
>　　　　　　Set rngTarget = .Find(What:=strType, Lookat:=xlWhole)
>　　　　End If
>　　End With
>　　On Error GoTo 0
>　　If (rngTarget Is Nothing) Then

ここの所は、rngTarget が設定されているかだけを見たいので
（Find がエラーなら・・・面倒なので）エラーを無視しておいてから
Find 自体が何らかのエラーの時には rngTarget には設定されないので初期化しておいて
Find が動いたら何らかが rngTarget に設定される（ Nothing 含む）

としたものになります。

※ 91 エラーだった根本部分は

> Set rngTarget = Range("CP44:CP100").Find(・・・
> intTarget = rngTarget.Row

で、見つからなかった時 rngTarget は Nothing 状態
にもかかわらず、rngTarget.Row　としていたから・・・

最低でも、rngTarget は Nothing かどうか判別すべき・・・・

記述を見ると、その判別する箇所は２か所あり、
面倒なのでエラーで飛ばして、一括で処理すれば良いか・・・という記述に見えます

で、制御Bから制御Aに復帰するでもなく、Goto で処理を続けたため、
２回目では、そのままエラーの表示に・・・

復帰するのなら、Resume BBB とか・・・するんでしょうか

※ Next i と　D_Error: の間に後は、通常 Exit Sub 等記述します。
でないと、正常な処理で For ～ Next i を抜けてきたとしても、
D_Error: 以降の処理も走る事になります。

※ ということで、AAA: 部分で何をしているか、わらないですね・・・

お礼

回答ありがとうございます。

>>>空白行多々、等々で結構読みにくい VBA 記述ですね。
本当にそうですね。失礼しました。

>>>Resume せずに Goto とかで、いろんなところから処理を続けても、制御Bから抜け出した事にはなりません。
なるほど、、、

初心者のため自分で判断できる範囲のものを使用してどうにか作っています。
みなさんのコードを見せていただいて、とても参考になりました。

ありがとうございました。

回答No.4

bin-chan

＃１です。
＃２・＃３さんの回答が美しい。

DDD:の前のExit Subの理由についてです。

VBAのコードは上から下へ実行されて行くので、
エラートラップ処理部分も（エラーが無くても）実行されちゃう。
（AAA:も必ず通ることになりますよ）

それを防ぎ本筋と切り離すためExitSubが必要、ということです。

お礼

回答ありがとうございました。

なるほど、エラートラップを避けるために必要だったのですね。

よくわかりました。

回答No.3

30246kiku

＃２です

まだ閉じられていなかったので、参考になれば

＃２の雰囲気記述で、
エラーを発生させない様に変更した部分に気づきいていましたか。

>　　　　　　For Each v In vA
>　　　　　　　　intStr = InStr(strType, v)
>　　　　　　　　If (intStr > 0) Then
>　　　　　　　　　　strType = Left(strType, intStr - 1)
>　　　　　　　　　　Exit For
>　　　　　　　　End If
>　　　　　　Next

この部分になるのですが、

>　　vA = Array("(-", "-")

としていたので、文字列の中に "(-" があるか・・・ "-" があるか・・・
あったら、strType を、 Find 用の文字列にして For を抜ける
なければ intStr = 0 の状態で For を抜けていく
特別な事をやっている処理ではないと思います。

> If Mid(strType, intStr - 1, 2) = "(-" Then

で、"-" があったら、１文字前が "(" ですか？
という記述ですが、

文字列先頭が "-" で、１文字前を Mid すると エラー 5 が発生しますね
intStr > 1 とかの判別記述が必要と思います
もしくは、intStr = 1 なら、Find 等以降の処理をスキップするとか・・・

上記 For Each で作られる文字列は、最悪 "" （空文字）になりますが、
後は Find の動き次第・・・っていうものになりますね・・・
"" （空文字）なら、Find 等以降の処理をスキップするでも良いかも・・・

あとは、
・処理を始める時には、対象のセルの色をクリアしてから・・・
・メッセージを出す時には、たぶんそのシートが見えている？？
　なら、色を付けてからメッセージ表示すれば、どこか・・・が、わかり易い？
・隣り合った連続したセルを扱う時には、一纏めにして扱うと速い？
・・・

回答No.1

bin-chan

Goto. 使っちゃダメ。
エラー分岐してから判断させるのでは無く、先に判断してからforループ作ったら？

タブレットからの投稿のため細かな入力が出来ないので、BBBのとこだけ。
> If Len(Trim(Cells(i, "D").Value)) = 0 Then ' D列のデータがなければ次の行へ
の次２行は不要。
’GoTo BBB
’End If
その代わりにElseを追加。

intStr = 0
から
BBB:
の直前のEnd Ifまでを右へインデントして
BBB:のとこにEnd Ifを追加。

DDD:の前に、 Exit Sub を追加。

補足

早速の回答、ありがとうございました。

>>>DDD:の前に、 Exit Sub を追加。
この意味がよく分からなかったのですが、

>>>エラー分岐してから判断させるのでは無く、先に判断してからforループ作ったら？
上記のご指導から、rngTarget is Nothing の場合、エラー表示が出るように変更、
>>>次２行は不要。
>>>’GoTo BBB
>>>’End If
>>>その代わりにElseを追加。　
上記のご指導から、D列のデータがあれば処理をするよう変更してみました。

助かりました。ありがとうございます。

これでどうにか希望する動きをしてくれたのですが、「同一エラーが2回目出たとき」、1回目はエラーハンドラで対応できるのに、なぜ2回目以降は「実行時エラー91」が表示されてしまうのでしょうか？

この2回目以降のエラー表示は避けられないものなんでしょうか？

Sub test()

Dim i As Integer
Dim lng As Long

i = 8

lng = 15

On Error GoTo D_Error

i = 8

Cells(i, "D").Value = StrConv(Cells(i, "D").Value, vbUpperCase) '半角小文字は半角大文字に修正

strType = Cells(i, "D").Value

For i = 8 To lng

Cells(i, "D").Value = Trim(StrConv(Cells(i, "D").Value, vbUpperCase)) '半角小文字は半角大文字に修正し、余分なスペースも取る

strType = Cells(i, "D").Value

If Len(Trim(Cells(i, "D").Value)) <> 0 Then ' D列のデータがあれば処理を実行

intStr = 0

Cells(i, "D").Select

strType = Cells(i, "D").Value

intStr = InStr(strType, "-") 'ハイフンの位置で調べる

If intStr = 0 Then 'ハイフンがなければ、あいまい検索で文字列を探す

Set rngTarget = Range("CP44:CP100").Find(What:=strType, lookat:=xlPart)

Else 'ハイフンがあれば、「(」カッコの有無を調べてから、「-」前の文字を完全一致で探す

If Mid(strType, intStr - 1, 2) = "(-" Then
strType = Left(strType, intStr - 1 - 1)

Else
strType = Left(strType, intStr - 1)

End If

Set rngTarget = Range("CP44:CP100").Find(What:=strType, lookat:=xlWhole)

End If

If rngTarget Is Nothing Then

MsgBox "CP列に該当する型式がありません。" & Chr(13) _
& Chr(13) _
& "　　型式があるものには「-」を使用してください。" & Chr(13) _
& " それ以外はCP44～CP100にデータを入力してください。"

ActiveSheet.Cells(i, "D").Interior.ColorIndex = 3

Else

intTarget = rngTarget.Row

Cells(i, "AE").Value = Cells(intTarget, "CR").Value
Cells(i, "AF").Value = Cells(intTarget, "CS").Value
Cells(i, "AG").Value = Cells(intTarget, "CT").Value

End If

End If

Next i

D_Error:

If Err.Number = 91 Then

If i > lng Then
GoTo AAA
End If

'MsgBox "CP列に該当する型式がありません。" & Chr(13) _
'& Chr(13) _
'& "　　型式があるものには「-」を使用してください。" & Chr(13) _
'& " それ以外はCP44～CP100にデータを入力してください。"

'ActiveSheet.Cells(i, "D").Interior.ColorIndex = 3

'GoTo BBB

Else

GoTo AAA

End If

AAA: 'D8から下にデータがない場合

Set rngTarget = Range("CP44:CP100").Find(What:=strType, lookat:=xlPart) '完全一致の解除

Range("D8").Select

End Sub