- ベストアンサー
Excel VBAのループ処理で特定の回のみスキップする方法
cj_moverの回答
こんにちは。お邪魔します。 やっぱり具体例がないと迷っちゃいそうなので、 先ごろご一緒したQAの題材をアレンジして 実践をイメージした前提で話を進めてみますね。 参考QA 『マクロを簡潔にしたいので教えてください。』 http://okwave.jp/qa/q8072449.html # たぶん今回ご質問のきっかけ、なのかな?と思ってたり。 ダミーサンプルを作成されていらっしゃったなら、 実際にテストできて話が早いと思ったので、 参考QAの設定をお借りして、仕様を替えたもので試します。 参考QAでは、検索ヒットしなければ有無を言わさずExit Subする動作仕様でしたが ヒットしなかった分は出力先を空欄のまま次の行に飛ぶように替えてみます。 # エラー制御を十分なものにするという意味では、 ご質問のポイント以外にも幾つかあると思いますが、 今回は必要なものだけにしています(解り難くならない為に)。 # で、今回ご質問の要件に合わせてプロシージャひとつに纏めたのですが、 元コードを活かすようにアレンジしたものですから、 私自身が仕上げるコードとは別物なので、 参考QAで提示したものや今回提示するコードへのツッコミはご勘弁を。 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() ' 関連QA 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
関連するQ&A
- ループが走りません
Sub COIN() Dim shSAI As Worksheet Dim shTAN As Worksheet Dim inROW As Long Set shSAI = Sheets("最終") Set shTAN = Sheets("単価") For inROW = 10 To shSAI.UsedRange.Rows.Count If shTAN.Range("C" & inROW) = shTAN.Range("C4") Then shSAI.Range("G" & inROW).Value = shSAI.Range("G6").Value End If Next Set shSAI = Nothing Set shTAN = Nothing End Sub 上記のようなコードを書きました 動作としては「最終」シートC10から下へ続く文字に対し、「単価」シートC4と同一であれば、 「最終」シートG10から下へ続くG列に、「単価」シートG6の数値をあてはめたいと考えております。 「最終」シートのC列は、場合によっては下に続くため、C10から始まり最終行までの検索するループを作りたいのですが、ループが走りません。 当方全くの素人でありますが、問題点がお分かりの方がおりましたら、教えて下さい。
- ベストアンサー
- Visual Basic
- VBA ループ処理 "型が違います"エラー
"sheet1"のA1:J1を"sheet2"のA1:J1にコピー "sheet1"のA2:J2を"sheet2"のA2:J2にコピー "sheet1"のA3:J3を"sheet2"のA3:J3にコピー これを"sheet1"A:Jが空欄になるまでループさせたいのですが、 どうしてもエラーが出てしまいます。。。 前回も同様の質問をして、回答を頂いたのですが、 自分なりに応用を利かせてやってみたら、エラーが出てしまいます>< ------------------------------------------------------------ Sub cpy2() Dim i As Long Dim Sht1 As Range Dim Sht2 As Range Set Sht1 = Sheets("Sheet1").Range("A1:J1") ←("A1")ではエラーは出ません。 Set Sht2 = Sheets("Sheet2").Range("A1:J1") ←("A1")ではエラーは出ません。 For i = 0 To 65535 If Sht1.Offset(i) <> "" Then ←ここでエラーが出ます"型が違います" Sht2.Offset(i) = Sht1.Offset(i) Else Exit For End If Next End Sub -------------------------------------------------------------- 教えて下さい。お願いします。
- ベストアンサー
- Visual Basic
- Excel2010 VBA 条件色付け
Sub sample() Dim r As Range For Each r In Range("q6:q30") If myIsNumeric(r) Then r.Offset(0, 1).Value = "数字" Else r.Offset(0, 1).Value = "文字" End If Next End Sub Function myIsNumeric(Target As Range) Dim r As Range Dim buf, tmp Dim flg As Boolean Dim i As Integer buf = Target For i = 1 To Len(buf) tmp = Mid(buf, i, 1) If IsNumeric(tmp) Then flg = True Exit For End If Next myIsNumeric = flg End Function を数字が入ってたら塗りつぶさないで、 数字が入ってなかったら塗りつぶすように直したいです。 あああ→塗る あああ1-1→塗らない 住所→塗る 住所12→塗らない
- ベストアンサー
- Excel(エクセル)
- Excel VBA 指定シートの有無確認
指定した名前のシートがあるかないか判断させてますが、 以下のやりかたでは、 グラフ作成したシートを認識してくれません。 そのようにすれば良いでしょうか? Dim ws As Worksheet, flag As Boolean For Each ws In Worksheets If ws.Name = "シート" Then flag = True Next ws If flag = True Then msgbox "あります Else Sheets.Add ActiveSheet.Name = "シート" End If
- ベストアンサー
- Visual Basic
- ExcelVBAの知恵をお貸しください。
一つのシートで、複数のセル範囲を選択している場合に、セル範囲を選択しているのか?列、行を選択しているのかを判別する方法として次のようなのを考えました。 それとなく動いているのですが、なんとなくスマートでなく、場当たり的な感じがしますが、どのようにすればいいのか判りません!! どなたか、アドバイス頂けないでしょうか?宜しくお願いいたします。 Sub test() Dim myRang As Range Dim myArry As Variant For Each myRang In Selection.Areas myArry = Split(Replace(myRang.Address, ":", ""), "$") If UBound(myArry) <> 2 Then MsgBox "セル範囲を選択しています。" & myRang.Address Else If IsNumeric(myArry(1)) Then MsgBox "行を選択しています。" & myRang.Address Else MsgBox "列を選択しています。" & myRang.Address End If End If Next End Sub
- ベストアンサー
- オフィス系ソフト
- エクセル 転記ループが上手くいきません
シート2のA列の数値と、シート3のA列の数値が一致したら、シート2のB列の数値をシート3のB列に転記したいです。(実際はもうちょっと複雑ですが・・) 実際はデータ量があるため、処理時間を少なくしたくて、配列に挑戦してみました。 処理は最後まで行くのですが、転記がされません。 どうしてでしょうか?? どなたか教えてください!!! Sub sample2() Dim i As Long Dim ii As Long Dim last As Long Dim last2 As Long Dim MyArray1 Dim MyArray2 last = Sheets("sheet2").Cells(Rows.Count, 1).End(xlUp).Row last2 = Sheets("sheet3").Cells(Rows.Count, 1).End(xlUp).Row MyArray1 = Sheets("sheet2").Range("A1:B" & last) MyArray2 = Sheets("sheet3").Range("A1:B" & last2) For i = LBound(MyArray1, 1) To UBound(MyArray1, 1) For ii = LBound(MyArray2, 1) To UBound(MyArray2, 1) If MyArray1(i, 1) = MyArray2(ii, 1) Then MyArray2(ii, 2) = MyArray1(i, 2) End If Next Next End Sub
- ベストアンサー
- Excel(エクセル)
- ExcelVBA 非連続域の扱い(01)
お世話になります。 添付映像の、ような 非連続域の、扱いに 困って、います 下記に、記載の コードに、おいて 2回目、以降に Function 最小値域(… に、 制御が、回た 際の >フィールド.Rows.Count が、 1に、成り 困って、います。 と、言うか 抑も、 非連続域の、扱い方が 全く 解って、いません どう、取得し、 どう、扱い、 どう、指定し、 どう、渡す、 のか… 等、 なので >Evaluate("MIN(" & フィ… や、 >For Each カウンター In フィールド.Range(Cells(… 等の、 Range指定、等も 間違えて、いる と、思います 其処で、 非連続域の、扱い に、ついて どうぞ、ご指南を 宜しく、お願いします。 記 Option Base 1 Option Explicit Type ランゲポイント形式 左 As Long 右 As Long 上 As Long 下 As Long End Type Function 最小値域(ByVal フィールド As Range, ByVal 列 As Long, Optional ByVal 指標値 As Variant) As Range Dim ポイント As ランゲポイント形式, ランゲ As Range, カウンター As Range, 注目行 As Long Let ポイント.上 = 1 Let ポイント.左 = 1 Let ポイント.下 = フィールド.Rows.Count Let ポイント.右 = フィールド.Columns.Count Set ランゲ = Nothing Set カウンター = Nothing If IsMissing(指標値) _ Then Set 指標値 = Evaluate("MIN(" & フィールド.Range(Cells(列, ポイント.上), Cells(列, ポイント.下)).Value & ")") End If For Each カウンター In フィールド.Range(Cells(列, ポイント.上), Cells(列, ポイント.下)) If カウンター.Value = 指標値 _ Then Let 注目行 = カウンター.Row If ランゲ Is Nothing _ Then Set ランゲ = フィールド.Range(Cells(注目行, ポイント.左), Cells(注目行, ポイント.右)) Else Set ランゲ = Union(ランゲ, フィールド.Range(Cells(注目行, ポイント.左), Cells(注目行, ポイント.右))) End If End If Next Set 最小値域 = ランゲ End Function Sub main() Dim ダミー As Range Set ダミー = 最小値域(最小値域(最小値域(Range("sheet2!B2:e9"), 2, "A"), 3), 4) End Sub 以上
- ベストアンサー
- Excel(エクセル)
- Forループの制御について
VB 2005,Framework2.0を使用しています。 For文を使ったループについてお尋ねしたいことがあります。 For i As Integer = 0 To 10 ’処理 Next i とあったとします。 そうするとループ変数iが0から10になるまで連続してループを行うのですが、これをある条件の時に現在のループ変数から一つ飛ばして次のループからまた処理を行いたい場合どのようにすれば良いのでしょうか? 例えば0~10回中に、現在5回目で特定の条件が一致したときその次の6回目のループは飛ばして7回目のループから再開したいです。 ちなみにこの様に書いても0から10回必ずループされてしまいました。 Dim TEST(10) As Integer TEST(5) = 1 For i As Integer = 0 To 10 If TEST(i) = 1 Then i = i + 1 End If Next i
- ベストアンサー
- Visual Basic
- ExcelVBA データのコピー範囲について
あけましておめでとうございます。今年もよろしくお願いします。 Sub Test() Dim myTarget As Range, r As Range, f Set myTarget = Sheets("Sheet1"). _ Range("B2", Sheets("Sheet1").Range("B65536").End(xlUp)) For Each r In myTarget Set f = Sheets("Sheet2").Columns(1). _ Find(r.Value, Sheets("Sheet2").Range("A1"), Lookat:=xlWhole) If Not f Is Nothing Then If r.Offset(0, 3).Value <> f.Offset(0, 3).Value Then f.Resize(1, 4).Copy Destination:= _ Sheets("Sheet3").Range("A65536").End(xlUp).Offset(1, 0) End If End If Next r End Sub 前回の質問で教えていただいたコードなのですが、現時点では、B列のデータを元にして二つのSheetのデータを比較して別Sheetへコピーしているのですが、そのときに、B列以降の(たとえば、B列からX列まで)データはコピーできますが、A列もコピーしたい時はどうすればよいのかで、悩んでいます。どの様に変更すればよいのでしょうか?
- ベストアンサー
- オフィス系ソフト
補足
何時もお世話になっています。 未だデバッグ終わっていなかったですし、 こんな形で公開するのは、何か自慢たらたらげで嫌み野郎な感じだし そもそも恥ずかしいし 憚ったのですが、 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 一応VBEでコンパイルまでは済ませてありまが、 未だ開発途中で… あと、 設計意図が統一できていないかも知れません。 おまけに、 チャレンジングな「これってできるのかな?」と、云う内容が盛り込まれています。 出来るのか疑問です。 やってみれば?… て、とこなのですが、 先にスタックオーバーフローの問題を片付けたくなりまして、 質問させて頂いた次第です。 今回は、良い感じですが もっと多重なループが組まれていて その幾つか外に出たい時など、 入り組んでしまてる場合の スタックが解放されるかが懸念されます。