ＥｘｃｅｌＶＢＡ その回のみループを終わらせる

質問

お世話になります。

初歩的かも知れませんが、解らないことが見つかりましたので、お助け下さい。

質問内容
For Each等のループの中で、
その回のループ処理が不必要な場合、
Ｎｅｘｔから次に進める方法

Dim Flag As Boolean
Sub main()
Dim 調査範囲 As Range, レンジ As Range, ダスト As Long, シート1 As String
　　シート1 = …
　　　　…
　　　　…
　　　　…
　　For Eact レンジ In 調査範囲
　　　　Flag = False
　　　　…
　　　　…
　　　　…
　　　　ダスト = ダミー()
　　　　…
　　　　…
　　　　With sheets(シート1)
　　　　If Flag _
　　　　　　Then
　　　　　　　　'　　　←　　此所の書き方です
　　　　　　End If
　　　　End With
　　　　…
　　　　…
　　Next レンジ
　　　　…
　　　　…
　　　　…
　　　　…
　　　　…
Ｅｎｄ Sub

Function ダミー() As long
　　　　…
　　　　…
　　If 何たら = かんたら Then Flag = True
　　　　…
　　　　…
　　　　…
End Function

これは1例ですが
Do Loopや通常のFor Nextなどの場合も併せて
どう書けば、スタックオーバーフロー無しに
Nextに安全に飛ばせられるか？
ご教示をお願い致します。

但しGo To以外でお願いします。
スパゲッティはやです　汗

回答No.3

cj_mover · ベストアンサー

こんにちは。お邪魔します。

やっぱり具体例がないと迷っちゃいそうなので、
先ごろご一緒したＱＡの題材をアレンジして
実践をイメージした前提で話を進めてみますね。

参考ＱＡ
　　『マクロを簡潔にしたいので教えてください。』
　　http://okwave.jp/qa/q8072449.html
# たぶん今回ご質問のきっかけ、なのかな？と思ってたり。

ダミーサンプルを作成されていらっしゃったなら、
実際にテストできて話が早いと思ったので、
参考ＱＡの設定をお借りして、仕様を替えたもので試します。

参考ＱＡでは、検索ヒットしなければ有無を言わさずExit Subする動作仕様でしたが
ヒットしなかった分は出力先を空欄のまま次の行に飛ぶように替えてみます。

# エラー制御を十分なものにするという意味では、
　ご質問のポイント以外にも幾つかあると思いますが、
　今回は必要なものだけにしています（解り難くならない為に）。

# で、今回ご質問の要件に合わせてプロシージャひとつに纏めたのですが、
　元コードを活かすようにアレンジしたものですから、
　私自身が仕上げるコードとは別物なので、
　参考ＱＡで提示したものや今回提示するコードへのツッコミはご勘弁を。

GoTo などのフロー制御を用いずに構造化してゆく、というのは
それでいいと思いますが、
具体的には、If Then Else や、Select Case （場合によっては For Next や Do Loop など）
などで条件分岐する以外にはないですよね。
でも、それはそれで読み難い場合もあって、例えば、
　下の方に書いてある End If はどんな条件分岐だったか、
　だいぶ上の行までVBEのコードペインをスクロールしなきゃ記述を確認できないような場合
とか
　ネストが深くて End If がズラっと並んで読み難かったり
とか、コーディングによっては、フローの方が余程、構造が見える場合も稀にあったりするので、
一昔前のように「...べきでない」的な扱いで GoTo ステートメントが
必要以上に悪者にされている場面は、最近は見かけなくなってきましたね。
乱用は困るけど、明らかに GoTo の方が読み易い場合などは
使ってもいいかな、と私は思っています。

なので、本当は、具体的なニーズに照らして考えないと、回答はおろか意見も書けない位
微妙なテーマだったりしますね。
# 私信ですが、Noubleさんの取り組む姿勢には友好的でいられるつもりですが、
　先日も申し上げた通り、実践イメージor実際に動くコード、がないと
　お手伝いするのにも限界がありますので、概論的な質問スレへの参加は
　今後あまり期待しないでください。

今回お借りした題材の場合だと、If Then Else で条件分岐するのが普通だと思います。
ひたすら
　　If testno <> "" Then
　　Else
　　End if
並列で書く方がスッキリして好き、という人もいれば、
どれだけネストしても最短の処理を優先する人もいるかと思います。
# 下の例も、色々書けますね。

# 一応紹介しておきますが、
　　　　End If　　'　If testno <> "" Then
　のように記述が遠く離れたステートメントの対応をメモしておくだけでも、
　コードを読む側からすれば、随分違って見えます。

# んー、なんか、もっとスッキリ書くべきなんでしょうけど、最近不調です。
　和風スパゲッティ、、、とか？
　題意に副ってなかったらすみません。

Sub Re8074402() ' 関連ＱＡ　8072449
　　Dim basedata(0 To 10) As String ' baseData(0) は testNo 用に予め確保
　　Dim testno As String
　　Dim weight(1 To 16) As Double
　　Dim weightA(1 To 6) As Double
　　Dim weightB(7 To 12) As Double
　　Dim printRow As Long
　　Dim testrow As Long
　　Dim i As Long
　　Dim flgEsc As Boolean

　　Sheets("sh3").Select ' ◆シート名◆
　　Range("A3:AA17").ClearContents

　　For printRow = 3 To 17
　　　　testno = Trim(Cells(printRow + 20, "B"))

　　　　If testno <> "" Then
　　　　　　flgEsc = False
　　　　　　With Sheets("sh1") ' ◆シート名◆
　　　　　　　　For testrow = .Cells(65536, 1).End(xlUp).Row To 6 Step -1
　　　　　　　　　　If CStr(.Cells(testrow, 1)) = testno Then Exit For
　　　　　　　　Next testrow
　　　　　　　　If testrow < 6 Then
　　　　　　　　　　flgEsc = True
　　　　　　　　Else
　　　　　　　　　　For i = 1 To 10
　　　　　　　　　　　　basedata(i) = .Cells(testrow, i + 1)
　　　　　　　　　　Next i
　　　　　　　　End If
　　　　　　End With

　　　　　　If Not flgEsc Then
　　　　　　　　With Sheets("sh2") ' ◆シート名◆
　　　　　　　　　　For testrow = .Cells(65536, 1).End(xlUp).Row To 6 Step -1
　　　　　　　　　　　　If CStr(.Cells(testrow, 1)) = testno Then Exit For
　　　　　　　　　　Next testrow
　　　　　　　　　　If testrow < 6 Then
　　　　　　　　　　　　flgEsc = True
　　　　　　　　　　Else
　　　　　　　　　　　　For i = 1 To 6
　　　　　　　　　　　　　　weight(i) = .Cells(testrow, i + 1)
　　　　　　　　　　　　　　weightA(i) = weight(i)
　　　　　　　　　　　　Next i
　　　　　　　　　　　　For i = 7 To 12
　　　　　　　　　　　　　　weight(i) = .Cells(testrow, i + 2)
　　　　　　　　　　　　　　weightB(i) = weight(i)
　　　　　　　　　　　　Next i
　　　　　　　　　　End If
　　　　　　　　End With　　'　With Sheets("sh2")

　　　　　　　　If Not flgEsc Then
　　　　　　　　　　basedata(0) = testno
　　　　　　　　　　Cells(printRow, 1).Resize(, 11).Value = basedata

　　　　　　　　　　weight(13) = Application.Max(weightA)
　　　　　　　　　　weight(14) = Application.Min(weightA)
　　　　　　　　　　weight(15) = Application.Max(weightB)
　　　　　　　　　　weight(16) = Application.Min(weightB)
　　　　　　　　　　Cells(printRow, 12).Resize(, 16).Value = weight
　　　　　　　　End If
　　　　　　End If　　'　If Not flgEsc Then
　　　　　　Erase basedata, weight, weightA, weightB
　　　　End If　　'　If testno <> "" Then
　　Next printRow
End Sub

補足

何時もお世話になっています。

未だデバッグ終わっていなかったですし、
こんな形で公開するのは、何か自慢たらたらげで嫌み野郎な感じだし
そもそも恥ずかしいし
憚ったのですが、

cj_mover様がお求めになっているなら…

笑わないでくださいね、

Option　Explicit
Const　データ範囲上限　=　6　_
　　　　,　検査値シート　=　"sh3"　_
　　　　,　開始位置　=　1　_
　　　　,　終了位置　=　2
Dim　Flag　As　Boolean

Function　行検索(ByVal　シート1　As　String,　ByVal　検査値　As　Range)　As　Long
Dim　検索範囲　As　Range
　　　　Set　検索範囲　=　Sheets(シート1).Range("a:a")
　　　　行検索　=　Evaluate("Max((検索範囲.Val　=　検査値.Val)　*　Row(検索範囲))")
End　Function

Function　最小値(ByRef　範囲　As　Range)　As　Double
　　　　最小値　=　Evaluate("Min(範囲)")
End　Function

Function　最大値(ByRef　範囲　As　Range)　As　Double
　　　　最大値　=　Evaluate("Max(範囲)")
End　Function

Function　ランゲ読出(ByVal　シート2　As　String,　ByVal　検索値　As　String,　_
　　　　　　　　　　　　　　　　　　　　ByVal　評価範囲01　As　Long,　ByVal　評価範囲02　As　Long)　As　Range
Dim　行ポインター　As　Long
　　　　行ポインター　=　行検索(シート2,　Sheets(検査値シート).Range(検索値))
　　　　If　行ポインター　<　データ範囲上限　_
　　　　Then
　　　　　　　　Flag　=　True
　　　　　　　　Set　ランゲ読出　=　Nothing
　　　　　　　　Exit　Function　'　　←　此所はまだましだから良いとして
　　　　End　If
　　　　With　Sheets(シート2)
　　　　　　　　Set　ランゲ読出　=　.Range(.Cells(行ポインター,　評価範囲01),　.Cells(行ポインター,　評価範囲02))
　　　　End　With
End　Function

Function　検索読出し大(ByVal　シート2　As　String,　ByVal　検索値　As　String,　_
　　　　　　　　　　　　　　　　　　　　　　　　ByVal　評価範囲01　As　Long,　ByVal　評価範囲02　As　Long)　As　Double
　　　　　　　　検索読出し大　=　最大値(ランゲ読出(シート2,　検索値,　評価範囲01,　評価範囲02))
End　Function

Function　検索読出し小(ByVal　シート2　As　String,　ByVal　検索値　As　String,　_
　　　　　　　　　　　　　　　　　　　　　　　　ByVal　評価範囲01　As　Long,　ByVal　評価範囲02　As　Long)　As　Double
　　　　　　　　検索読出し小　=　最小値(ランゲ読出(シート2,　検索値,　評価範囲01,　評価範囲02))
End　Function

Sub　main()
Dim　カウンター　As　Long,　記入行　As　Long
Dim　ウエイト　As　Variant,　ベースデータ　As　Range,　ランゲ　As　Range,　検査レンジ　As　Range
Dim　シート1　As　String,　シート2　As　String,　シート3　As　String,　検査値　As　String
Dim　評価範囲(1　To　3,　1　To　2)　As　Long,　評価範囲M2　As　Long,　評価範囲M3　As　Long
Dim　評価範囲M4　As　Long,　評価範囲M5　As　Long,　評価範囲M6　As　Long
Dim　インターフェイス　As　String
　　　　インターフェイス　=　""
　　　　カウンター　=　0
　　　　シート1　=　"sh1"
　　　　シート2　=　"sh2"
　　　　評価範囲(1,　開始位置)　=　2
　　　　評価範囲(1,　終了位置)　=　11
　　　　評価範囲(2,　開始位置)　=　2
　　　　評価範囲(2,　終了位置)　=　7
　　　　評価範囲(3,　開始位置)　=　9
　　　　評価範囲(3,　終了位置)　=　14
　　　　Set　検査レンジ　=　Sheets(シート3).Range("B23").End(xlToRight).Column
　　　　For　Each　ランゲ　In　検査レンジ
　　　　　　　　Flag　=　False
　　　　　　　　カウンター　=　カウンター　+　1
　　　　　　　　検査値　=　"B"　&　CStr(22　+　カウンター)
　　　　　　　　記入行　=　カウンター　+　2
　　　　　　　　Set　ベースデータ　=　ランゲ読出(シート1,　検査値,　評価範囲(1,　開始位置),　評価範囲(1,　終了位置))
　　　　　　　　If　Flag　_
　　　　　　　　Then
　　　　　　　　　　　　If　インターフェイス　<>　""　_
　　　　　　　　　　　　Then
　　　　　　　　　　　　　　　　インターフェイス　=　検査値　&　"は、見つかりませんでした"
　　　　　　　　　　　　Else
　　　　　　　　　　　　　　　　インターフェイス　=　インターフェイス　&　vbNewLine　&　検査値　&　"も、見つかりませんでした"
　　　　　　　　　　　　End　If
　　　　　　　　　　　　With　Sheets(検査値シート)
　　　　　　　　　　　　　　　　Set　.Cells(記入行,　1)　=　.Range(検査値)
　　　　　　　　　　　　End　With

'　　　　　　　　　　　此所に　「Next　ランゲ」　を、置きたいところなのですが…　置けないですよね…

　　　　　　　　End If'　　←　これを「Else」に 変えて
　　　　　　　　Set　ウエイト　_
　　　　　　　　　　　　=　Array(　_
　　　　　　　　　　　　　　　　ランゲ読出(シート2,　検査値,　評価範囲(2,　開始位置),　評価範囲(2,　終了位置)),　_
　　　　　　　　　　　　　　　　検索読出し大(シート2,　検査値,　評価範囲(2,　開始位置),　評価範囲(2,　終了位置)),　_
　　　　　　　　　　　　　　　　検索読出し小(シート2,　検査値,　評価範囲(2,　開始位置),　評価範囲(2,　終了位置)),　_
　　　　　　　　　　　　　　　　検索読出し大(シート2,　検査値,　評価範囲(3,　開始位置),　評価範囲(3,　終了位置)),　_
　　　　　　　　　　　　　　　　検索読出し小(シート2,　検査値,　評価範囲(3,　開始位置),　評価範囲(3,　終了位置))　_
　　　　　　　　　　　　　　　　)
　　　　　　　　With　Sheets(検査値シート)
　　　　　　　　　　　　Set　.Range(.Cells(記入行,　1),　Cells(記入行,　27))　=　_
　　　　　　　　　　　　　　　　Array(.Range(検査値),　ベースデータ,　ウエイト)
　　　　　　　　End　With'　　この下に「End If」を、置けば良いのですね
　　　　Next　ランゲ
　　　　Set　ベースデータ　=　Nothing
　　　　Set　ウエイト　=　Nothing
　　　　If　インターフェイス　=　""　Then　インターフェイス　=　"正常に検索が終わりました"
　　　　MsgBox　インターフェイス,　vbOKOnly　+　vbInformation,　"状況報告"
End　Sub

一応ＶＢＥでコンパイルまでは済ませてありまが、
未だ開発途中で…

あと、
設計意図が統一できていないかも知れません。

おまけに、
チャレンジングな「これってできるのかな？」と、云う内容が盛り込まれています。
出来るのか疑問です。

やってみれば？…
て、とこなのですが、
先にスタックオーバーフローの問題を片付けたくなりまして、
質問させて頂いた次第です。

今回は、良い感じですが
もっと多重なループが組まれていて
その幾つか外に出たい時など、
入り組んでしまてる場合の
スタックが解放されるかが懸念されます。

回答No.5

cj_mover

あー、例を挙げるなら、こんな感じの方が親切でしたか？

' ' ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

Option Explicit

　　Private basedata(0 To 10) As String ' baseData(0) は testNo 用に予め確保
　　Private testno As String
　　Private weight(1 To 16) As Double
　　Private weightA(1 To 6) As Double
　　Private weightB(7 To 12) As Double
　　Private printRow As Long
　　Private testrow As Long
　　Private i As Long
　　Private flgEsc As Boolean

Sub Main8074402() ' 関連ＱＡ　8072449
　　Sheets("sh3").Select ' ◆シート名◆
　　Range("A3:AA17").ClearContents
　　For printRow = 3 To 17
　　　　testno = Trim(Cells(printRow + 20, "B"))
　　　　If testno <> "" Then
　　　　　　flgEsc = False
　　　　　　SubBase
　　　　　　If Not flgEsc Then
　　　　　　　　SubWeight
　　　　　　　　If Not flgEsc Then
　　　　　　　　　　SubPrint
　　　　　　　　End If
　　　　　　End If
　　　　　　Erase basedata, weight, weightA, weightB
　　　　End If
　　Next printRow
End Sub

Private Sub SubBase()
　　With Sheets("sh1") ' ◆シート名◆
　　　　For testrow = .Cells(65536, 1).End(xlUp).Row To 6 Step -1
　　　　　　If CStr(.Cells(testrow, 1)) = testno Then Exit For
　　　　Next testrow
　　　　If testrow < 6 Then
　　　　　　flgEsc = True
　　　　　　Exit Sub
　　　　End If
　　　　For i = 1 To 10
　　　　　　basedata(i) = .Cells(testrow, i + 1)
　　　　Next i
　　End With
End Sub

Private Sub SubWeight()
　　With Sheets("sh2") ' ◆シート名◆
　　　　For testrow = .Cells(65536, 1).End(xlUp).Row To 6 Step -1
　　　　　　If CStr(.Cells(testrow, 1)) = testno Then Exit For
　　　　Next testrow
　　　　If testrow < 6 Then
　　　　　　flgEsc = True
　　　　　　Exit Sub
　　　　End If
　　　　For i = 1 To 6
　　　　　　weight(i) = .Cells(testrow, i + 1)
　　　　　　weightA(i) = weight(i)
　　　　Next i
　　　　For i = 7 To 12
　　　　　　weight(i) = .Cells(testrow, i + 2)
　　　　　　weightB(i) = weight(i)
　　　　Next i
　　End With
End Sub

Private Sub SubPrint()
　　basedata(0) = testno
　　Cells(printRow, 1).Resize(, 11).Value = basedata
　　weight(13) = Application.Max(weightA)
　　weight(14) = Application.Min(weightA)
　　weight(15) = Application.Max(weightB)
　　weight(16) = Application.Min(weightB)
　　Cells(printRow, 12).Resize(, 16).Value = weight
End Sub

' ' ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

んで、Exit Sub すれば With節の途中であってもオブジェクトアクセスは解放されますから。
（勿論インスタンスは別問題ですが、Sheetの場合は関係ないですね。）
モジュールで宣言した（Staticな）オベジェクト型変数を使う場合とかは
面倒みなくちゃいけませんけど、通常はメインProc.で解放するってことで。

お礼

有り難うございます。
やはりサブルーティンコールするのがスマートなのですね。

所で
CALL 書かれていないですけれど
別に不要なのですか？

回答No.4

cj_mover

すみません、訂正です。

誤）
ひたすら
　　If testno <> "" Then
　　Else
　　End if
並列で書く方が...

正）
ひたすら
　　If Not flgEsc Then
　　Else
　　End if
のように並列で書く方が...

失礼しました。
それと、
＃１、２のお礼や補足は読まずに投稿してしましましたが
こちらからお伝えすることは変える必要ないと思っていますので。

お礼

了解です、
有り難うございます。

回答No.2

tsubuyuki

> これは1例ですが
まったく「一例」になっていませんね。
何をどうしたいのか、処理の流れがサッパリわからないです。

一般的に繰り返し処理から抜けるには、
　　Exit For
　　Exit Do
などを用います。

これでは事足りない、と言うのであれば、
前後の処理、具体的な「一例」を補足ください。

お礼

Ｅｘｉｔ　Ｆｏｒは確かＦｏｒが終わってしまいますよね？
Ｎｅｘｔの次に行くのではなくて ですね

ＩＦ分のＴｈｅｎの所にＮｅｘｔを置く感覚でして
カウントを進ませてＦｏｒに戻る
そういった処理のやり方を求めているのです。

云うならば「此所でＮｅｘｔに遭遇させたい」と、云うことなのです。

でも、
ＶＢＡでは１つのＦｏｒに対してＮｅｘｔを複数置くと叱られますよね？

確かに
初期値を流動的にしておいて
ループを抜け出した後、
現段階のカウンター値の次からＦｏｒを再スタート
と、いう手もあるでしょうが、

これでは
Ｅｘｉｔの作用でスタック放棄されない限り
同一ルーティン内なので、スタックが破棄されることもないでしょうし、…

システム内にスタックされたＷｉｔｈやＩｆが解放されるか不安です。

１回のスタック量とループ脱出階数によっては
スタックがオーバーフローしそうじゃないですか。

もっと他に手はないものでしょうか？

補足

ＦｏｒからＮｅｘｔの間を全てサブルティンに置き換え、
これを呼び出して処理を行い

そのサブルティンの中で
その回の評価が不要と知れれば
Ｅｘｉｔ　Ｓｕｂする

そうすれば、
戻ったところに　Ｎｅｘｔが待ち構えている。

何ら問題なく
カウントが更新され　Ｆｏｒに戻り
次の１回の処理が始まる。

こうすれば良いのかも知れませんが、
これ以外のもっと慣例的？　と、云うか
平容？で簡単な、やり方が知りたいのです。

回答No.1

bin-chan

Exit Forでしょ。

Forループだから、Exit For
DoループならExit Do

ヘルプなり、Webなり、構文を読む習慣をつけたほうがよろしいかと。

参考URL：

http://msdn.microsoft.com/ja-jp/library/cc392459.aspx

補足

Ｅｘｉｔ　Ｆｏｒは確かＦｏｒが終わってしまいますよね？
Ｎｅｘｔの次に行くのではなくて ですね
ＩＦ分のＴｈｅｎの所にＮｅｘｔを置く感覚で
カウントを進ませてＦｏｒに戻る
そういった処理のやり方を求めているのです。

確かに
初期値を流動的にしてループを抜け出した後、
現段階のカウンター値の次からＦｏｒを再スタート
と、いう手もあるでしょうが、

これでは
同一ルーティン内なので、スタックが破棄されることもないでしょうし、
システム内にスタックされたＷｉｔｈやＩｆが解放されるか不安です。

１回のスタック量とループ脱出階数によっては
スタックがオーバーフローしそうじゃないですか。

もっと他に手はないものでしょうか？