• ベストアンサー

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」の意味が分かりません。 よろしくお願いします。

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

  • ベストアンサー
  • ham_kamo
  • ベストアンサー率55% (659/1197)
回答No.3

No.1です。 > なぜ、「1から9まで」なのですか？ > 「1から10まで」のような気がするのですが・・・ For～Nextの中のロジックをよく見てください。 「同じ数値が続けて入力されたら、最後のセル(一番下のセル)をＢ列にコピーする。」ということですが、「連続した同じ数字の最後のセル」であることをどう判定しているかというと、「次のセルと値が異なるセル」ということになります。それが以下のIf文です。 If .Cells(a).value <> .Cells(a + 1).value Then （a行目のセルとa+1行目のセルが違ったら） .Cells(a, 2).value = .Cells(a).value （B列のa行目に値を代入） しかし、ここでa+1という「一つ先」のセルの値を使用しています。aの値を10までまわすとA11というセルの値がIf文中に出てきてしまいます。これがまずいのです。 たとえばA1からA10に 1 1 2 2 3 3 4 4 5 5 と入っていると、4まではそれぞれ２つある下の方がB列にコピーされます。しかし、もし万が一A11に5という数値が入力されている場合、a=10までループをまわすと、 .Cells(a).value = .Cells(a + 1).value となってしまい、上のIf文が成り立たなくなります。その結果、B10にA10の値がコピーされなくなります。 それを避けるため、最大値より一つ減らしてループをまわしています。 そして最後のセル（この場合A10）ですが、 ・A9とA10の値が違う場合→A10から新たに連続する数字が始まるが、指定範囲がA10までなので、A10が一番下ということになる→B列にコピー ・A9とA10の値が同じ場合→A10が指定範囲内の一番下のセルなので、後のセルに何が続こうがここで打ち止め→B列にコピー とどうころんでもA10はB10にコピーされることになります。 したがって、For～Nextの後に、 .Cells(.Count, 2).value = .Cells(.Count).value という、最後の行は無条件にB10にコピーする式が入っているのです。 そういうロジックなので、For文では .Count-1 までループするようになっています。

taka1012
質問者

お礼

ご丁寧な解説ありがとうございました。 とても参考になりました。

その他の回答 (2)

  • imogasi
  • ベストアンサー率27% (4737/17068)
回答No.2

>For idx = 1 To .Count - 1」の意味が分かりません 質問のコードのどこにループ変数　idx 　が出てますか。質問はしっかり書いてください。 それに質問のコードはメチャです。 Countはどこに定義さてますか For a = 1 To .Count - 1 If .Cells(a).valu は普通こういう使いか足しません。 Cells（i、ｊ）はiは行番号、ｊは列番号で実行までに値が決まっている必要があります。 ＞セルＡ1かＡ10において 「セルＡ1からＡ10において」のミスか ＞セルＡ1かＡ10において、同じ数値が続けて入力されたら、最後のセル(一番下のセル)をＢ列にコピーする。」 の意味も良くわからない。 ＞一番下のセルはA10のこと？ ２箇所同じセルがあればどうするの。？ 意味不明で自信ないが Sub ループ() j = 11 Dim a As Range With Range("a1:a10") For Each a In Range("A1:A10") If a.Value = a.Offset(1, 0).Value Then Cells(j, "b").Value = a.Value j = j + 1 End If Next End With End Sub のようなもの？

taka1012
質問者

お礼

説明不足、誤字がありごめんなさい。 >For idx = 1 To .Count - 1」の意味が分かりません ＞質問のコードのどこにループ変数　idx 　が出てますか。質問はしっかり書いてください。 「For a = 1 To .Count - 1」の誤りです。 ＞セルＡ1かＡ10において ＞「セルＡ1からＡ10において」のミスか そうです。 ＞一番下のセルはA10のこと？ ＞２箇所同じセルがあればどうするの。？ 具体例を書きます。 マクロ実行前 ....... A .......B 1... 777 2... 777 3... 4... 3 5... 3 6... 3 7... 777 8... 99 9... 99 10... 4 マクロ実行後 .... ... A...... B 1... 777 2... 777... 777 3... 4... 3 5... 3 6... 3... 3 7... 777... 777 8... 99 9... 99... 99 10... 4... 4 よろしくお願いします。

  • ham_kamo
  • ベストアンサー率55% (659/1197)
回答No.1

With Range("a1:a10") の中にあるので、 .Count は、Range("a1:a10").Count の意味で、このセル範囲の中のセル数を意味します。この場合A1:A10には10個のセルがあるので、 For a = 1 To .Count - 1 は変数aに1から9まで代入しながらループするということです。

taka1012
質問者

お礼

早速のご回答ありがとうございました。 ＞変数aに1から9まで代入しながらループするということです。 なぜ、「1から9まで」なのですか？ 「1から10まで」のような気がするのですが・・・ よろしくお願いします。

  1. カテゴリ
  2. [技術者向] コンピューター
  3. プログラミング・開発
  4. Visual Basic

関連するQ&A

  • VBA マクロ処理時間の短縮について

    下記のコードを作りましたが、マクロを実行すると砂時計マークが表示されて、処理が終了するまでに３０秒くらいかかります。 コードを変更して、マクロ処理時間を短縮する事はできないでしょうか？ Sub A列のコピー() Dim rw2 As Long Dim rw1 As Long Dim newdate As Date With Worksheets("sheet1") rw2 = .cells(.Rows.Count, "c").End(xlUp).Row newdate = .Range("c" & rw2).value For rw1 = rw2 - 1 To 1 Step -1 If .Range("c" & rw1).value <> newdate Then Exit For Next rw1 .Range(.cells(rw1 + 1, 1), .cells(rw2, 1)).Copy Worksheets("sheet2").Range("v6").PasteSpecial xlValue If rw1 + 26 <= rw2 Then .Range(.cells(rw1 + 26, 1), .cells(rw2, 1)).Copy Worksheets("sheet2").Range("v40").PasteSpecial xlValue Application.CutCopyMode = False End If Application.CutCopyMode = False End With End Sub 各セルは、６０００行くらいまで表示されています。 　よろしくお願いします。

  • 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

  • VBA Range・Cellsプロパティについて

    下記のコードについて質問致します。 Sub 特定のセルをコピー() Dim rw2 As Long Dim rw1 As Long Dim newdate As Date With Worksheets("steet1") rw2 = .cells(.Rows.Count, "c").End(xlUp).Row newdate = .Range("c" & rw2).value For rw1 = rw2 - 1 To 1 Step -1 If .Range("c" & rw1).value <> newdate Then Exit For Next rw1 .Range(.cells(rw1 + 1, 1), .cells(rw2, 1)).Copy 　　　 '(1) Worksheets("steet2").Range("v6").PasteSpecial xlValue End With End Sub (1)部分のコードの意味が分かりません。 よろしくお願いします。

  • Excelで同一セル内に入力されているデータを他のセルに分割したい

    http://okwave.jp/qa4369634.html?ans_count_asc=20 で質問をして、何度かやりとりをさせていただいて エクセルで同一セル内に、セル内改行で１～６列ほどのデータが入力されています。 縦にデータが入力されていて、それぞれのセルにセル内改行を含み、データが入力されています。 それぞれのセル内のデータを… 例えば、A1セル内に５行入力されていたら、A2セルから入力されている行数分（ここでいうと5行）挿入し、それぞれにデータを分割して入力させたい。 かつ、B・Cセルは増えたセルにそれぞれのデータをコピーしたいと言ったら、 Sub Macro1() Dim idx, cnt As Integer Dim wkStr() As String Dim rng As Range 　　ActiveSheet.Copy after:=ActiveSheet 　　For idx = Range("A65536").End(xlUp).Row To 1 Step -1 　　　　If InStr(Cells(idx, "A"), Chr(10)) > 0 Then 　　　　　　wkStr = Split(Cells(idx, "A").Value, Chr(10)) 　　　　　　Set rng = Cells(idx, "B") 　　　　　　For cnt = UBound(wkStr) To 0 Step -1 　　　　　　　　Cells(idx, "A").Value = wkStr(cnt) 　　　　　　　　Cells(idx, "B").Value = rng.Value 　　　　　　　　Cells(idx, "C").Value = rng.Offset(0, 1).Value 　　　　　　　　If cnt > 0 Then 　　　　　　　　　　Cells(idx, "A").Resize(1, 3).Insert shift:=xlDown 　　　　　　　　End If 　　　　　　Next cnt 　　　　End If 　　Next idx End Sub といったマクロのご回答をいただきました。 これを元に、 ・データが入っているセルをA列→B列に変更 ・A列のデータはセルが増えた分だけ増やしたい ・A1に対応するデータがC1・D1に入っていた場合、対応するデータは残したまま、B列が増えただけ、列を増やしたい と変更したいのですが…。 すいませんが、宜しくお願い致します。

  • VBA ユーザーフォーム

    VBA初心者です。以下の様なソースを見つけました。この場合は、文字を検索するとD1 にその該当番号が表示されます。 ※A列には番号、B列には文字列 そうではなく、そのクリックした行のA列にセルが移動し、ユーザーフォームが閉じられる様にできますでしょうか？ よろしくお願い致します。 Private Sub ListBox1_Click() Sheets("Sheet1").Range("D1").Value = ListBox1.Value End Sub Private Sub TextBox1_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean) Dim v() As Variant Dim c As Range Dim k As Long ListBox1.Clear With Sheets("Sheet1") With .Range("A1", .Range("A" & .Rows.Count).End(xlUp)) ReDim v(1 To 2, 1 To .Rows.Count) For Each c In .Cells If c.Offset(, 1).Value Like TextBox1.Value & "*" Then k = k + 1 v(1, k) = c.Value v(2, k) = c.Offset(, 1).Value End If Next If k = 0 Then MsgBox "指定の値は存在しません" Else ReDim Preserve v(1 To 2, 1 To k) ListBox1.List = WorksheetFunction.Transpose(v) End If End With End With End Sub

  • VBAについて

    現在マクロ勉強中です。 教えて頂きたいのは、登録ボタンで指定セルの台帳への転記する方法です。 Private Sub cmdToroku_Click() Dim myrow As Integer Option Explicit With ActiveSheet If .Range("A4").Value = "" Then myrow = 1 Else myrow = .Range(Cells(.Rows.Count, 1).End(xlUp).Address).Row + 1 End If .Cells(myrow, 1).Value = TextBox1.Value End With End Sub 上記ですと、開いているシートのA1に入力されてしまいます。 別シートへ転記したい場合どのあたりを修正すればよいのでしょうか？ お力お借りできれば幸いです。

  • EXCEL VBAの配列でわかりません。

    こんなコードがあるのですが、最後の他のシート（作業中シート）に書き込もうとするとエラーになってしまいます。”Sheets("作業中").”を抜くと同じシートに結果は返ってくるのですが…。コードの内容は、ある範囲のある列から空白ではないセルを探し出してその行のデータを配列で汲み取り、他のシートに一括で洗い出すというものです。 Sub 作業中() Dim myRow As Long Dim Data As Variant Dim WC() As Variant Dim WCE() As Variant myRow = Range("H1").CurrentRegion.Rows.Count Data = Range("H1:M" & myRow).Value For i = 1 To myRow If Data(i, 5) <> "" Then a = a + 1 Else b = b + 1 End If Next ReDim WC(a) ReDim WCE(b) c = 0 d = 0 For i = 1 To myRow If Data(i, 5) <> "" Then WC(c) = Range("H" & i & ":K" & i).Value c = c + 1 Else WCE(d) = Range(Cells(i, 8), Cells(i, 11)).Value d = d + 1 End If Next For i = 0 To a Range(Cells(i + 1, 15), Cells(i + 1, 18)).Value = WC(i) Next For i = 0 To b Range(Cells(i + 1, 19), Cells(i + 1, 22)).Value = WCE(i) Next e = Range(Cells(1, 15), Cells(a, 18)).Value Sheets("作業中").Range(Cells(1, 1), Cells(a, 4)).Value = e End Sub ちなみに同じシートから↓のコードを実行するとうまくいきます。 なぜ～？？わからな～い？？おしえてくださーい！！ Sub test() Dim a As Variant a = Range("H1:K4") Sheets("作業中").Range("N1:Q4") = a End Sub

  • ２つのVBAを組み合わせる方法

    お世話になります、２つのVBAを組み合わせる方法で迷っています。 １つ目が Private Sub Worksheet_Change(ByVal Target As Range) Dim i As Long, k As Long, myNum As Long If Intersect(Target, Range("C1,B9:B39")) Is Nothing Or Target.Count > 1 Then Exit Sub Application.EnableEvents = False With Target If .Column = 3 Then myNum = WorksheetFunction.Max(Range("B9:B39")) If IsDate(.Value) Then For i = 9 To 39 If Cells(i, "A").Value = "" Then Cells(i, "B").Value = "" Else Cells(i, "B") = myNum + i - 8 End If Next i End If Else i = .Row If .Value = "" Then Range(Cells(i + 1, "B"), Cells(39, "B")).ClearContents Else For k = i + 1 To 39 If Cells(k, "A").Value = "" Then Cells(k, "B").Value = "" Else Cells(k, "B") = Cells(k - 1, "B") + 1 End If Next k End If End If End With Application.EnableEvents = True End Sub です。 ２つめが Private Sub Worksheet_Change(ByVal Target As Range)　 Application.EnableEvents = True If Intersect(Target, Range("R8:R38")) Is Nothing Then Exit Sub Application.EnableEvents = False Range(Cells(Target.Row, 18), Cells(39, 18)).Value = Target.Value Application.EnableEvents = True End Sub です。２つのPrivate Sub Worksheet_Change(ByVal Target As Range)イベントのVBAですが、どのようにして組み合わせれば良いのでしょうか？

  • VBAの解説

    お世話になります 値、セルの操作ですが列数等の変更が生じたため変更を求められています。 下記ＶＢＡ判りやすく説明できる方お願い致します。 Sub Macro1() Dim idxR, idxC, ptr As Integer Dim ws As Worksheet Set ws = ActiveSheet Worksheets.Add after:=ws ptr = 2 With ws .Rows(1).Copy Destination:=Range("A1") For idxR = 2 To .Range("A65536").End(xlUp).Row Cells(ptr, "A").Value = .Cells(idxR, "A").Value For idxC = 2 To 255 Step 2 If .Cells(idxR, idxC) = "" Then Exit For Else .Cells(idxR, idxC).Resize(1, 2).Copy Destination:=Cells(ptr, "B") ptr = ptr + 1 End If Next idxC Next idxR End With End Sub

  • このVBAコードの解説をお願いします。

    特定の行の中で同じものが続いたらセルを結合する、ということがやりたくて 以下のコードをネット上から探してきました。 上記の動作は実現できたのですが、自分でこのコードをみてもイマイチわかりません。 お分かりになる方、できれば1行ずつ解説してください。 よろしくお願いします。 Sub Sample() Dim myRng As Range, myRow As Long Set myRng = Range("A1") For myRow = 1 To Cells(Rows.Count, 1).End(xlUp).Row With Cells(myRow, 1) If .Value = .Offset(1).Value Then Set myRng = Union(myRng, .Offset(1)) Else Application.DisplayAlerts = False myRng.Merge Application.DisplayAlerts = True Set myRng = .Offset(1) End If End With Next End Sub

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

あなたにピッタリな商品が見つかる！ OKWAVEセレクト

質問する