VBAでループ処理を行いたい
- VBAで指定行をスキップしてループ処理を行いたいです。具体的には、Retsu_01の処理を15ずつずらして、Retsu_02の処理を行いたいです。
- Excelの特定のセルに日付が入力されている場合に、隣のセルの背景色を変更する処理を行いたいです。
- ループ処理の中で特定の条件に合致する場合に処理を行いたいです。具体的には、指定したセルが日付であり、その隣のセルが空白の場合に、別のセルの背景色を変更する処理です。
- ベストアンサー
VBA 指定行飛ばしてLOOP処理したい。
LOOP処理で困っております。 お返事をいただけると幸いです。 ”★” 部分の構文が判りません。何卒よろしくお願いいたします。 こちらにEXCELBOOKがあります。 https://www.tenpu.me/download/b0zpgttzagnaj11pl9bh8c6ahb0yayji ファイル解凍PASS：0109 Sub SAMPLE() Dim Gyo_01 As Integer, Retsu_01 As Integer For Gyo_01 = 3 To 1300 For Retsu_01 = 26 To 41 ’★ ↑このループの次の処理を 42 to 57 ・ 58 to 73 ....と15づつズラシテ処理したい。 最終が234 To 249 で終わる（画像のグループ01.グループ02......） For Retsu_02 = 10 To 23 ’★ ↑この数値はRetsu_01の１回の処理につき一つづつ増加（画像のG1.G2.G3.....） Retsu_01 = 26 To 41 の時は10 Retsu_01 = 42 To 57 の時は11 Retsu_01 = 58 To 73 の時は12 Retsu_01 = 234 To 249 の時は23 If TypeName(Cells(Gyo_01, Retsu_01).Value) <> "Date" Then ElseIf Cells(Gyo_01, Retsu_01).Value = Date And Cells(Gyo_01, Retsu_01 + 1).Value = "" Then Cells(Gyo_01, Retsu_02).Interior.ColorIndex = 20 End If Next Retsu_●● '★ ←これがをどうしたら良いかわかりません Next Gyo_01 End Sub
- wata_oc3
- お礼率23% (3/13)
- Excel（エクセル）
- 回答数5
- ありがとう数3
- みんなの回答 （5）
- 専門家の回答
質問者が選んだベストアンサー
ANo.3です。 勘違いしていた部分がありましたのでコードを訂正します。 Sub SAMPLE_work() Dim Gyo_01 As Integer, Retsu_01 As Integer For Gyo_01 = 3 To 1300 For Retsu_02 = 10 To 23 nStart = Retsu_02 * 16 - 134 For Retsu_01 = nStart To (nStart + 14) If TypeName(Cells(Gyo_01, Retsu_01).Value) <> "Date" Then 'ここの処理は？ ElseIf Cells(Gyo_01, Retsu_01).Value >= Date And Cells(Gyo_01, Retsu_01 + 1).Value = "" Then Cells(Gyo_01, Retsu_02).Interior.ColorIndex = 20 End If Next Retsu_01 Next Retsu_02 Next Gyo_01 End Sub
その他の回答 (4)
- bunjii
- ベストアンサー率43% (3589/8248)
>For Retsu_01 = 26 To 41 >’★ ↑このループの次の処理を 42 to 57 ・ 58 to 73 ....と15づつズラシテ処理したい。 外側の「For Gyo_01 = 3 To 1300 ・・・・ Next Gyo_1」ループとの関係は？ 「指定行飛ばしてLOOP処理したい。」との希望が何を意味しているかが分かりません。 フローチャートを書いて仕事の流れを明確にしないと無駄な悪足掻きをすることになります。 >For Retsu_02 = 10 To 23 >’★ ↑この数値はRetsu_01の１回の処理につき一つづつ増加（画像のG1.G2.G3.....） G1～G16をRetsu_01のループで条件に見合うとき塗りつぶしを行っているようですが、無駄なチェックをしているようです。 >Next Retsu_●● '★ ←これがをどうしたら良いかわかりません Next Retsu_02 が必要です。 尚、Next Retsu_01 も提示のコードにはありませんので追加が必要でしょう。 他に「ElseIf Cells(Gyo_01, Retsu_01).Value = Date And Cells(Gyo_01, Retsu_01 + 1).Value = "" Then」の論理式「Cells(Gyo_01, Retsu_01).Value = Date」は再確認が必要かと思います。（タイプミス？または値の勘違い？） 当方で動作確認した範囲で添削した結果は次のとおりです。 Sub SAMPLE() Dim Gyo_01 As Integer, Retsu_01 As Integer For Gyo_01 = 3 To 1300 For Retsu_01 = 26 To 41 If TypeName(Cells(Gyo_01, Retsu_01).Value) <> "Date" Then ElseIf TypeName(Cells(Gyo_01, Retsu_01).Value) = "Date" And Cells(Gyo_01, Retsu_01 + 1).Value = "" Then For retsu_02 = 10 To 23 Cells(Gyo_01, retsu_02).Interior.ColorIndex = 20 Next retsu_02 End If Next Retsu_01 Next Gyo_01 End Sub 但し、「指定行飛ばしてLOOP処理したい。」との要望は意味不明のため加味されていません。
- mt2015
- ベストアンサー率49% (258/524)
出所が解らないExcelブックは怖いのでダウンロードしていません。 こういう事がやりたいのでしょうか？ Sub SAMPLE_work() Dim Gyo_01 As Integer, Retsu_01 As Integer For Gyo_01 = 3 To 1300 For Retsu_02 = 10 To 23 For Retsu_01 = Retsu_02 To (Retsu_02 + 15) 'ここで良いのかな？ If TypeName(Cells(Gyo_01, Retsu_01).Value) <> "Date" Then 'ここの処理は？ ElseIf Cells(Gyo_01, Retsu_01).Value = Date And Cells(Gyo_01, Retsu_01 + 1).Value = "" Then Cells(Gyo_01, Retsu_02).Interior.ColorIndex = 20 End If Next Retsu_01 Next Retsu_02 Next Gyo_01 End Sub
補足
連絡ありがとうございます。 不慣れなもので、申し訳ございません。 上手く処理できませんでしたが、近いと思います。 勉強不足で原因もわかりません。 グループ0１の計算は以下で出来ます。 Dim Gyo_01 As Integer, Gyo_02 As Integer For Gyo_01 = 3 To 1300 For Retsu_01 = 26 To 39 If TypeName(Cells(Gyo_01, Retsu_01).Value) <> "Date" Then ElseIf Cells(Gyo_01, Retsu_01).Value >= Date And Cells(Gyo_01, Retsu_01 + 1).Value = "" Then Cells(Gyo_01, 10).Interior.ColorIndex = 20 End If Next Retsu_01 Next Gyo_01 グループ02.03..と13迄処理を続けたいです。 G1 検索範囲 26 To 39 反映セル 10 G1 検索範囲 42 To 57 反映セル 11 G1 検索範囲 58 To 73 反映セル 12 ・・・・ G1 検索範囲 234 To 249 反映セル 23 お力添えをお願いいたします。
- HohoPapa
- ベストアンサー率65% (454/692)
現コードを生かすなら Sub SAMPLE() Dim Gyo_01 As Integer, Retsu_01 As Integer Dim BlocCount as integer BlocCount = 0 For Gyo_01 = 3 To 1300 For Retsu_01 = 26 To 249 if ((Retsu_01 - 10) mod 16 = 0) then BlocCount = BlocCount + 1 end if for Retsu_02 = (BlocCount-1 + 10) To (BlocCount-1 + 10 + 13) Next Retsu_02 Next Retsu_01 Next Gyo_01 End Sub といった感じでしょうか。 動作確認はしていません。悪しからず。
補足
現コードをいかさなくても問題ありません。 勉強不足につきそもそもの定義が違う可能性があります。 グループ0１の計算は以下で出来ます。 Dim Gyo_01 As Integer, Gyo_02 As Integer For Gyo_01 = 3 To 1300 For Retsu_01 = 26 To 39 If TypeName(Cells(Gyo_01, Retsu_01).Value) <> "Date" Then ElseIf Cells(Gyo_01, Retsu_01).Value >= Date And Cells(Gyo_01, Retsu_01 + 1).Value = "" Then Cells(Gyo_01, 10).Interior.ColorIndex = 20 End If Next Retsu_01 Next Gyo_01 グループ02.03..と13迄処理を続けたいです。 G1 検索範囲 26 To 39 反映セル 10 G1 検索範囲 42 To 57 反映セル 11 G1 検索範囲 58 To 73 反映セル 12 ・・・・ G1 検索範囲 234 To 249 反映セル 23 お力添えをお願いいたします。
Swith Case は使え・・While Wend で良いと 処理しようと、終いと５０回まわす場合は For loop_i=0 to 49 ってやるけど、条件が合うなら入る・・・って言うのは For 使わない。
補足
連絡ありがとうございます。 「Swith Case」勉強してみます。 今後ともよろしくお願いいたします。
関連するQ&A
- EXCEL VBAについて
EXCEL VBAについて教えてください やりたいことは以下の通りです。 ・全シートJ列1～100行目を検索しアルファベットが含まれるセルが存在すれば 上のセルをコピーする ここまで作ったのですが上手くいきません Sub VBAsample() Dim GYO As Long For GYO = 1 To 100 If Find([a-z], LookAt:=xlPart) Then Cells(GYO, 10).Value = Cells(GYO - 1, 10).Value End If Next GYO End Sub 添削をお願いします
- ベストアンサー
- オフィス系ソフト
- VBA処理速度の向上（配列？）
いつもお世話になっております。 エクセルVBA勉強中の初心者です。 書籍などを参考に、下記コードを作成し、セル内データを計算しています。 セル数が少ない場合には良かったのですが、将来的には、 約30,000行×100列程度になる予定で、処理に時間がかかってしまっています。 （現状で10,000行×50列程度、データは増えていきます。） 過去ログ、HPなどを調べると、配列に入れれば、処理速度が格段に上がると あったのですが、如何せん私には難しく、理解できませんでした・・・ 配列に限らず、処理速度が上がる方法をご教授、添削頂ければ助かります。 よろしくお願いいたします。 Sub test() Dim Gyo As Long, Retu As Long For Gyo = 3 To Range("A65536").End(xlUp).Row For Retu = 1 To Range("D3").End(xlToRight).Column Cells(Gyo, Retu).Value = Cells(Gyo, Retu).Value / 1000000 Next Retu Next Gyo End Sub
- ベストアンサー
- オフィス系ソフト
- VBAで行列を作る方法
次のようなプログラミングで１，０，－１の要素で作られる3×3行列を全通り調べています。 この場合３の９乗通り調べることができます。 これを4×4や５×５行列など数を大きくして調べたいのですが、このプログラムを配列を使うなどして 簡単にできる方法を教えてください。 よろしくおねがいします。 Sub test() Dim a As Integer '行 Dim b As Integer '列 Dim c As Integer, i As Integer, j As Integer, d As Integer, e As Integer Dim 内積 As Integer, step As Integer Dim f As Integer, g As Integer, h As Integer, l As Integer, m As Integer, n As Integer, k As Integer, x As Integer Dim sum As Integer, total As Integer Dim aa As Integer, aaa As Integer, aaaa As Integer, bb As Integer, bbb As Integer, bbbb As Integer a = 3 '行 b = 3 '列 c = 0 内積 = 0 con = 0 sum = 0 tatal = 0 aa = 0 aaa = 0 aaaa = 0 bb = 0 bbb = 0 bbbb = 0 x = 0 For n = 0 To 2 For m = 0 To 2 For l = 0 To 2 For k = 0 To 2 For h = 0 To 2 For g = 0 To 2 For f = 0 To 2 For e = 0 To 2 For d = 0 To 2 '要素がすべて１ For i = 1 To a For j = 1 To b Cells(i, j) = 1 Next j Next i If bbbb = 1 Then Cells(a - 2, b - 2) = 0 ElseIf bbbb = 2 Then Cells(a - 2, b - 2) = -1 End If If bbb = 1 Then Cells(a - 1, b - 2) = 0 ElseIf bbb = 2 Then Cells(a - 1, b - 2) = -1 End If If bb = 1 Then Cells(a, b - 2) = 0 ElseIf bb = 2 Then Cells(a, b - 2) = -1 End If If aaaa = 1 Then Cells(a - 2, b - 1) = 0 ElseIf aaaa = 2 Then Cells(a - 2, b - 1) = -1 End If If aaa = 1 Then Cells(a - 1, b - 1) = 0 ElseIf aaa = 2 Then Cells(a - 1, b - 1) = -1 End If If aa = 1 Then Cells(a, b - 1) = 0 ElseIf aa = 2 Then Cells(a, b - 1) = -1 End If If total = 1 Then Cells(a - 2, b) = 0 ElseIf total = 2 Then Cells(a - 2, b) = -1 End If If sum = 1 Then Cells(a - 1, b) = 0 ElseIf sum = 2 Then Cells(a - 1, b) = -1 End If If con = 1 Then Cells(a, b) = 0 ElseIf con = 2 Then Cells(a, b) = -1 End If con = con + 1 Next d con = 0 sum = sum + 1 Next e sum = 0 total = total + 1 Next f total = 0 aa = aa + 1 Next g aa= 0 aaa = aaa + 1 Next h aaa = 0 aaaa = aaaa + 1 Next k aaaa = 0 bb = bb + 1 Next l bb = 0 bbb = bbb + 1 Next m bbb = 0 bbbb = bbbb + 1 Next n End Sub
- ベストアンサー
- オフィス系ソフト
- VBAのループ処理について
VBA（Excel2000）にて、参考書等を見て下記のコードを作成しました。 「セルＡ1かＡ10において、同じ数値が続けて入力されたら、最後のセル(一番下のセル)をＢ列にコピーする。」 Sub ループ() Dim a As Long With Range("a1:a10") For a = 1 To .Count - 1 If .Cells(a).value <> .Cells(a + 1).value Then .Cells(a, 2).value = .Cells(a).value End If Next .Cells(.Count, 2).value = .Cells(.Count).value End With End Sub 上記の「For idx = 1 To .Count - 1」の意味が分かりません。 よろしくお願いします。
- ベストアンサー
- Visual Basic
- ▲ExcelのVBA▼困っています
何度もVBAで質問させてもらい助けてもらっています。 懲りずにまた質問ですが… 下のプログラムは"●"が跳ね返るものなのですが… ●の後を■と▲が追うようなプログラムにするには なにを追加すればいいのでしょうか…？; どなたか教えて下さい;;お願いします;; Dim time1 As Integer, time As Integer Dim X As Integer, Y As Integer Dim maru As String, yoko As String, tate As String Sub 描画() Cells(X, Y).Value = maru End Sub Sub 削除() Cells(X, Y).Value = "" End Sub Sub 待機() For time1 = 0 To 1000 For time2 = 0 To 1000 Next Next End Sub Sub 座標移動() If yoko = "右" Then Y = Y + 1 Else Y = Y - 1 End If If Y = 30 Then yoko = "左" ElseIf Y = 1 Then yoko = "右" End If If tate = "上" Then X = X + 1 Else X = X - 1 End If If X = 20 Then tate = "下" ElseIf X = 1 Then tate = "上" End If End Sub Sub main() maru = "●" X = 1 Y = 1 yoko = "右" tate = "上" Do 描画 待機 削除 待機 座標移動 Loop End Sub
- ベストアンサー
- その他（プログラミング・開発）
- EXCEL VBAで、途中で処理が終わってしまいます。
お世話になります。No.843313の続きになるのですが、思った通りに動いてくれませんでした。 やりたいことは、「Cells(97,4)まで数字が入ったら、次はCells(7,13)に移動して処理１を繰返したい」というものなのですが、Cells(97,4)まで入ったところで終了してしまい、次のCells(7,13)へ移動してくれません。エラーメッセージも出ていません。 どうしたらいいのでしょうか？宜しくお願いします。 （見やすいように字下げできませんでした。見難くてごめんなさい。） iii = 4 With sheetIRO ’処理１ For ii = 7 To 97 Step 10 If .Cells(ii, iii).Value = "" Then .Range(.Cells(ii, iii), .Cells(ii + 4, iii + 2)).Value _ = Sheets("Result").Range("G20：I24").Value Exit For End If If ii = 97 Then iii = iii + 9 ii = 7 Exit Sub End If Next ii End With
- ベストアンサー
- Windows系OS
- Excel VBAについて
Excel VBAについて VBA初心者ですが、作業で使うファイルを使いやすくしようと思っているのですが行き詰ってしまいました。 是非、知恵をお貸しいただきたいと質問させていただきました。 フォームを使ってデータを打ち込むようにしようと思っています。 日付の列を選択するとフォームが立ち上がり、必要項目を記入するというものです。 日付欄が未記入なら「新規」、記入済みなら「修正」 という風にしたいのですが、うまくいきません・・・ 修正しようと入力しなおしても新規として新しい行に書かれてしまいます。 色々と自分で勉強して下のような書き方をしましたが、何がいけないのでしょうか。 ご指摘おねがいいたしますm(__)m Public Sub KAKIKOMI(GYO As Long) GYO = ActiveCell.Row Load UserForm1 With UserForm1 If ((GYO = 17) Or (Cells(GYO, 3).Value = "")) Then GYO = 17 .hiduke.Text = "" .bunnrui.Text = "" .tantou.Text = "" .gaku.Text = "" .memo.Text = "" Else .hiduke.Text = Cells(GYO, 3).Value .bunnrui.Text = Cells(GYO, 7).Value .tantou.Text = Cells(GYO, 8).Value .gaku.Text = Cells(GYO, 9).Value .memo.Text = Cells(GYO, 11).Value .ComboBox1.Text = Cells(GYO, 5).Value End If g_swOK = 0 .Show If g_swOK <> 1 Then GoTo TOUROKU_EXIT If GYO = 17 Then GYO = 19 Do While Cells(GYO, 1).Value <> "" GYO = GYO + 1 Loop End If ActiveSheet.Unprotect Cells(GYO, 3).Value = Trim$(.hiduke.Text) Cells(GYO, 7).Value = Trim$(.bunnrui.Text) Cells(GYO, 8).Value = Trim$(.tantou.Text) Cells(GYO, 9).Value = Trim$(.gaku.Text) Cells(GYO, 11).Value = Trim$(.memo.Text) ActiveSheet.Protect End With End Sub ちなみに、17行目が見出しで、3列目が日付欄です。 よろしくお願いします。
- ベストアンサー
- その他MS Office製品
- VBAの処理を軽くしたい
各行ごとに5回セルを参照した結果を吐き出すプログラムを作成しています。 200行前後の処理が必要なのですが、現在のコードではあまりにも処理が重くなっています。 とにかく処理を軽くしたいのですが、どのような方法が考えられるでしょうか？ 初心者なのでコードも含めてご教示頂けたら幸いです。 Sub test(b, c, d) Dim i1, i2 As Long Dim A1 As String For i1=0 To Cells(Rows.Count, 1).End(xlUp).Row For i2 = 0 To 5 If Range(b).offset(i1, i2).Value = "x1" Or Range(c).offset(i1, i2).Value = "x1" Then A1 = "XXX" ElseIf Range(b).offset(i1, i2).Value = Range(c).offset(i1, i2).Value Then A1 = "YYY" Else A1 = "ZZZ" End If Range(d).offset(i1, i2).Value = A1 Next i2 Next i1 End Sub
- ベストアンサー
- その他MS Office製品
- Excel VBA; 複数のループ処理
↓のようなコードがあります。 Dim i As Long, MaxRow1 As Long, MaxRow2 As Long MaxRow1 = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row MaxRow2 = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row For i = 1 To MaxRow1 Worksheets("Sheet1").Cells(i, 1).Value = i . Next i For i = 1 To MaxRow2 Worksheets("Sheet2").Cells(i, 1).Value = i . Next i これらを最大行の多いシートに合わせて、パフォーマンスを良くしたいと思います。 同様の処理をシート1、シート2で実施しているので纏めて記述したいです。 シート1、シート2に対する処理をサブルーチンにする方法しかありませんか? どなたかお願いします。 If MaxRow1 >= MaxRow2 Then For i = 1 To MaxRow1 Else For i = 1 To MaxRow2 End If Worksheets("Sheet1").Cells(i, 1).Value = i Worksheets("Sheet2").Cells(i, 1).Value = i . Next i
- ベストアンサー
- Visual Basic
- EXCEL VBA 多種のコンボボックス操作
こんばんは。 現在ユーザーフォーム上に10個のコンボボックスを配置しています。 1-8は共通リストを、9と10は別々のリストを表示させたいのですが・・ Private Sub UserForm_Initialize() Dim X, No, Y As Integer With UserForm2 For No = 1 To 8 For X = 0 To 7 .Controls("ComboBox" & No).AddItem Worksheets("Letter").Cells(X + 1, 10).Value Next Next For Y = 0 To 7 .ComboBox9.AddItem Worksheets("Letter").Cells(Y + 1, 11).Value .ComboBox10.AddItem Worksheets("Letter").Cells(Y + 1,12).Value Next End With End Sub 上記のコードですが、エラーが出てどうにも行き詰っています。 Private Sub UserForm_Initialize() Dim X, No As Integer For No = 1 To 8 For X = 0 To 7 UserForm2.Controls("ComboBox" & No).AddItem Worksheets("Letter").Cells(X + 1, 10).Value Next Next End Sub ↑だと1-8まで問題なく動くのですが・・・ すみませんが、アドバイスお願いいたします。
- 締切済み
- オフィス系ソフト
補足
迅速に対応頂きありがとうございます。 勉強になりました。