プロが教える店舗&オフィスのセキュリティ対策術

こんにちは。

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

A 回答 (4件)

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



処理が進む中で
・エラーを検知して、エラー処理に飛んでくれる制御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 かどうか判別すべき・・・・

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

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

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


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

※ ということで、AAA: 部分で何をしているか、わらないですね・・・
    • good
    • 0
この回答へのお礼

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

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

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

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

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

お礼日時:2014/09/14 20:59

#1です。


#2・#3さんの回答が美しい。


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

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

それを防ぎ本筋と切り離すためExitSubが必要、ということです。
    • good
    • 0
この回答へのお礼

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

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

よくわかりました。

お礼日時:2014/09/21 09:30

#2です



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


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

>      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

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

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

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


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

Goto. 使っちゃダメ。


エラー分岐してから判断させるのでは無く、先に判断してからforループ作ったら?

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

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


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

この回答への補足

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

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

>>>エラー分岐してから判断させるのでは無く、先に判断してからforループ作ったら?
上記のご指導から、rngTarget is Nothing の場合、エラー表示が出るように変更、
>>>次2行は不要。
>>>’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

補足日時:2014/09/14 09:34
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!