• ベストアンサー

Excel VBA のDo Until Loopについて

こんばんは Excel VBAの初心者です。 Do Until Loopを使って B列の値が変わるところ(下記の表だと、空白からコスモスに変わる、4行目。コスモスからチューリップに変わる6行目。チューリップから菊に変わる8行目。)に行を挿入させたいと思い、下記のマクロを組んだのですが、Do Until Loopが理解できませんでした。 どうしたら良いのか教えて頂けないでしょうか。 宜しくお願い致します。 Excelのシート B1  項目 B2  空白 B3  空白 B4  コスモス B5  コスモス B6  チューリップ B7  チューリップ B8  菊 Sub 行の挿入() Dim y As String Cells(2, 2).Select y = Cells(2, 2).Value Do Until Cells(2, 2).Value <> y ActiveCell.Offset(1).Select Selection.EntireRow.Select Selection.Insert shift:=xlDown Loop End Sub

質問者が選んだベストアンサー

  • ベストアンサー
  • rivoisu
  • ベストアンサー率36% (97/264)
回答No.2

まず全体を処理するLoopが必要 そのloopのなかでキーをセットしキーが変わるまでというloop キーが変わったところで(loopの次の行)で挿入処理 >Do Until Cells(2, 2).Value <> y Cells(2, 2)も yもLoopの中で変化しないので何時までも終わらない offsetは記述が長くなるので不適 VBAのコードの中では範囲をselectする必要はない場合が多い。 Sub 行の挿入() Dim i As Long Dim y As String i = 2 Do Until Cells(i, 2) = ""   y = Cells(i, 2).Value   Do Until Cells(i, 2).Value <> y     i = i + 1   Loop   Cells(i, 2).EntireRow.Insert shift:=xlDown   i = i + 1 Loop End Sub

その他の回答 (1)

回答No.1

Do Until 式 コード Loop 『式がFalseである場合にコードを実行し、Doへ戻れ』 これは Do While 式 = False Loop または Do While Not 式 Loop と同じです。 Do Until Cells(2, 2).Value <> y の場合、式は「セル(2, 2)の値がYと一致しない」ですので 『「セル(2, 2)の値がYと一致しない」がFalseである場合に、コードを実行し、Doに戻れ』 ・・・となりますが、二重否定構文になっているのでややこしいです。 (Not 式 = False) は (式 = True) となるので Do While Cells(2, 2).Value = y Loop と置き換えるとわかりやすいと思います。

mugigohan
質問者

お礼

最近VBAがわかってきたと思っていたのですが、 制御文になるとなかなか理解できませんでした。 細部まで教えてください。ありがとうございました。

関連するQ&A

  • Do loopのマクロ

    以下のマクロの問題点を教えていただきたいのです。 A列を上から順番に調べて、値が10のときだけBに分岐して処理を行い(処理の内容は省略してあります)、またAに戻って、空白のセルが見つかったら処理をやめる、というマクロです。 ところが、これを実行すると空白のセルが見つかってもマクロが止まりません。何が問題でしょうか。 Sub A() Cells(1, 1).Select A: Do Until ActiveCell.Value = "" If ActiveCell.Value = 10 Then GoTo B End If ActiveCell.Offset(1, 0).Select Loop B: ActiveCell.Offset(1, 0).Select GoTo A End Sub

  • VBA Do Until内で値の貼り付けができない

    Excel2003を使用しております。 コピー&値のペースト作業をやってくれるマクロを作成しております。 具体的には、名簿に公がついていれば、その3つ左の名前をD27へ値のみコピペし、 D27がすでに値があれば、D28に書くことを、D37までループするようにしております。 しかし困ったことに、Do Untilコードを使用しておりますが、このコードではなぜか値の貼り付けが出来なくなります。 Sub Ns公() Dim work As Range Set work = Selection If Selection.Value = "公" Then ActiveCell.Offset(0, -3).Select Selection.Copy Do Until Range("D37").Select Range("D27").Select If Selection.Value = "" Then Selection.PasteSpecial paste:=xlPasteValues work.Select Else ActiveCell.Offset(1).Select End If Loop If Range("D36").Value <> "" Then Do Until Range("I37").Select Range("I27").Select If Selection.Value = "" Then Selection.PasteSpecial paste:=xlPasteValues work.Select Else ActiveCell.Offset(1).Select End If Loop work.Select End If work.Select End If work.Select ActiveCell.Offset(1).Select End Sub 原因や対策をご教授いただけるとうれしいです。よろしくお願いします。

  • Do~Loopステートメント

    Do~Loopステートメントで使わな方が良いステートメントとは? Do~Loopステートメントで「古いから使わない方がよい」、と言われたことがあるのですが どれの事だか忘れてしまいました。 Sub test() セルのA1~A10に1~10を入力する i = 1 Do While i < 11 Worksheets("Sheet1").Cells(i, 1).Value = i i = i + 1 Loop End Sub これは一般的だから使ってもよいと思います。 Sub test() セルのA1~A10に1~10を入力する i = 1 Do Until i = 11 Worksheets("Sheet1").Cells(i, 1).Value = i i = i + 1 Loop End Sub これもよく見かけます。 Do While,Do Until以外にもloopステートメントってありますか? あと使わない方が良いステートメント、私の勘違いでなければ教えてください。

  • VBA Do Until ~ Loop 内にif

    Excel VBAマクロにて、C列のセルのうちOKと書かれたセルのみ塗りつぶすコードを作成したつもりなのですが、動いてくれません。エラー表示も出ません。間違いを指摘して下さる方、あるいは別の書き方があるという方、教えていただけないでしょうか。 下記私が作成したものです。C列にAと書かれたセルが現れるまで処理をするようにしています。 Sub sample() Dim i As Long i = 1 Do Until Cells(i, "C").Value = ”A" If Cells(i, "C").Value = "OK" Then Cells(i, "C").Interior.ColorIndex = 5 End If i = i + 1 Loop End Sub

  • VBAで行を挿入する

    VBAを始めた初心者です。 Exel2002使用です。 VBAでA列の4行目から10行目に行の挿入をできるようにしようと下記のように書きましたが、Rows("i:i").Selectの部分でデバックがかかってしまいます。間違っている理由がわからないのですがよろしくお願いします。 また、DO While Loopステートメントを使ってA列が空白になるまで(例えばA4セル以下の)行を挿入とする場合の方法も教えていただけましたら幸いです。 Sub 4行目から10行目まで() Dim i As Integer For i = 4 To 10 Cells(i, 1).Value = i Rows("i:i").Select Selection.Insert Shift:=xlDown Next i End Sub Sub 4行目から空白になるまで() Dim i As Integer Range("A4").serect Do While activecell.value = "" Cells(i, 1).Value = i Rows("i:i").Select Selection.Insert Shift:=xlDown activecell.offset(1,0).select Loop End Sub

  • VBA Do~Loopについて

    VBA勉強中です。 マクロの作成は完了しているのですが、処理効率について指摘を受け、 その際に助言もいただいたのですが、自身の勉強不足、理解不足で どのように変更すれば良いのか分からず、教えていただきたいです。 Do While Ax2 <= 30 で30回繰り返すのではなく (Cells(Ax2,"B").Value <> "" ) の間繰り返すように変更したいです。 ---------------- Sub test()  Dim File1(30) As string  Dim Sheet1(30) As string  Dim Sheet2(30) As string  Dim Cnt As Integer  Ax1=1  Ax2=7  Do While Ax2 <= 30    If Cells(Ax2, "B").Value <> "" Then     File1(Ax1) = Cells(Ax2, "B").Value     Sheet1(Ax1) = Cells(Ax2, "C").Value     Sheet2(Ax1) = Cells(Ax2, "D").Value     Cnt =Ax1    End If    Ax1 = Ax1 + 1    Ax2 = Ax2 + 1  Loop End Sub ---------------- お手数ですが、よろしくお願いいたします。

  • VBA 九九 Do While

    VBAのDo Whileステートメントを使って九九の表をつくりたいのですが、何度やっても途中で詰まり、実行に至りません。 For NextとDo untilではできたと思うのですがDo Whileがどうしてもわからなくて… どなたか助けてください。お願いします。 Sub 九九計算_for() Dim i, j As Integer For i = 1 To 9 For j = 1 To 9 Cells(i, j).Value = i * j Next Next End Sub Sub 九九計算_do_until() j = 1 Do i = 1 Do Cells(j, i).Value = i * j i = i + 1 Loop Until i = 10 j = j + 1 Loop Until j = 10 End Sub

  • VBA Do Until Loopでエラー

    VBAは全くの素人です。 マクロの記録とInterNetでVBAコードを探し、下記のように記しました。 VBAのデバッグ&ステップインで(動作)確認するのですが、素人の悲しさか、Do Until IF の行で「コンパイル&構文エラー」に引っ掛かり先に進めません。 どの様に修正したらよいのかnetを探すのですが見つかりません。(探し方が足りない?) コードの右側に ‘‥‥やりたい事のコメントを記しています。 どの様にコードを修正したらよいのか、ご指導願えませんでしょうか?。 他の部分についてもご指導頂けると助かります。 Sub 練習1() Dim i As Integer '‥‥変数(繰り返し回数のカウント) iを宣言 i = 0 '‥‥変数iをリセット(0)にする(繰り返し回数のカウント) Range("$F$8").Select ActiveCell.FormulaR1C1 = 0 '‥‥F8をリセット(0)にする Dim waittime As Variant '‥‥待ち時間設定宣言 waittime = Now + TimeValue("0:00:10") '‥‥待ち時間10秒に設定 Do Until If Range("$G$8").Value = "Out" Then '‥‥「Goodになるまで繰り返しなさい」 Calculate ‘‥‥繰り返し計算せよ Else: Range("$G$8").Value = "Good" ‘‥‥Goodになれば繰り返し(Loop)完了 IF Range("$G$8").Value = Interior.colorIndex = 36 '‥‥$G$8が"Good"ならばセル色を36にする '尚、G8セルの計算式は=IF(AND($I$25="OK",$I$26="OK",$I$27="OK",$I$28="OK",$I$29="OK"),"Good","Out") Range("F8").Select ActiveCell.FormulaR1C1 i = i + 1 '‥‥変数iを1増やす(繰り返し回数のカウント) waittime = Now + TimeValue("0:00:10") '‥‥待ち時間10秒に設定 End If Calculate Loop '‥‥G8が”Good” になればVBA終了 Range("G8").Select End Sub

  • エクセルVBAについて

    エクセルVBA初心者です。 左の表からある一定以上の売上を得た人を抽出し、右の表に表示したいのですが以下のプログラムだと上手くいきません。 どこがダメなのでしょうか? Private Sub cmdUriken_Click() Dim k As Integer Dim l As Integer Dim m As Integer k = 2 l = 2 m = 2 Do Until Cells(m, 32) = "" Range(Cells(m, 19), Cells(m, 34)).Select Selection.ClearContents m = m + 1 Loop Do Until Cells(k, 14) = "" If Cells(k, 14) >= txtUriken.Text Then Range(Cells(k, 1), Cells(k, 16)).Select Selection.Copy Range(Cells(l, 19), Cells(l, 34)).Select ActiveSheet.Paste l = l + 1 Application.CutCopyMode = False End If k = k + 1 Loop End Sub ちなみに If Cells(k, 14) = txtUriken.Text Then とするとちゃんと同等の売上が表示されるので >= の使い方が間違っていると思うのですが よろしくお願いします。

  • ExcelのVBAについて教えてください

    ワークシートの1行目から、任意の行数(行数は毎回違う)を削除する方法を教えてください。 E1から下に見にいって空白でないセルが現れたら、 そのひとつ上の行までを削除する。 Range("E1").Select Do Until ActiveCell = "" If ActiveCell = "" Then Selection.Offset(-1).Select Loop ここまでできましたが、続きがわかりません。 よろしくお願いします。 あとVBAのコードについて詳しく載っているURLを ご存知でしたら教えてください。 よろしくお願いします。

専門家に質問してみよう