エクセルVBAの条件指定が上手くいかない!For Eachステートメントを7で抜けたいけど、何かがおかしい件
- エクセルVBAの条件指定が上手くいかず、For Eachステートメントを使用して7を超えたら抜ける処理を実装したいです。
- セルB1~D3までの値を1ずつ加算し、加算後の値をセルE~Gに表示します。しかし、7を超えても処理が継続してしまいます。
- 質問者はVBAの知識が不足しており、どのように修正すれば良いのか分かりません。アドバイスをお願いします。
- ベストアンサー
エクセルVBAの条件指定が上手くいきません
「7を超えたら、For Eachステートメントを抜けなさい」という条件を入れたいのですが、 7を超えても処理が継続し困っています。 勉強不足で申し訳ないですが、ご教授願います。 【やりたいこと】 まず、セルB1~D3までのセルの値(9つ)が、7を超えない条件で1を加算していきます。 加算したときの値はE~Gの列に貼り付けていきます。 7を超えた時点でFor Eachステートメントを抜けます。 また、B1~D3までのセルには計算式が入っており、A1に数字を入れると、 それぞれ異なる増え方をします。(計算式自体は$A$1+1.1、$A$1+2.1などシンプルなもの) Sub test() Dim i As Range Dim n As Long Dim x As Long n = 1 x = 1 For Each i In Range("B1:D3") Range("A1").Value = x If i < 7 Then Range("B1:D3").Copy Cells(n, 5).Select Selection.PasteSpecial Paste:=xlPasteValues n = n + 3 x = x + 1 ElseIf i > 7 Then Exit For End If Next End Sub お手数ですが、宜しくお願いいたします。
- DT7
- お礼率85% (6/7)
- オフィス系ソフト
- 回答数7
- ありがとう数7
- みんなの回答 (7)
- 専門家の回答
質問者が選んだベストアンサー
i をすべて iRange に変えてみてください。
その他の回答 (6)
- imogasi
- ベストアンサー率27% (4737/17068)
初心者はコードをそのまま載せるのでなく。やりたいことを、文章で説明すべきだ。本件ではないが、思いついたロジック(処理方法)が途方も無いものがあるので。 >Dim i As Range i は整数のカウンターとして使うことが多い。本件もRngとかの名称にすべきだ >Range("A1").Value = x x = x + 1 は本質問の分岐構造と関係ないでしょう。質問では省いて例に載せること。 >、セルB1~D3までのセルの値(9つ)が、7を超えない条件で1を加算していきます はA1セルに加算するか? 何のためにこうするのか意味不明だが。 >For Each i In Range("B1:D3") B1:D3の各セルを1セルつづつとらえる。 iが7を超える場合は、そこで処理を打ち切るのか、そのセルだけ処理を飛ばすのかはっきりしない。 打ち切りなら Sub test1() For Each i In Range("B1:D3") MsgBox i.Address & " " & i If i > 7 Then Exit For Next End Sub をやって、質問者のコードと比べて、考えてみたら。 7の場合の処理が質問でははっきりしない。コード上も抜けている? Sub test1() For Each i In Range("B1:D3") MsgBox i.Address & " " & i If i > 7 Then Exit For (コピー貼り付け処理) Next End Sub nは整数で良いのでは。2007か。エクセルバージョンぐらい書くこと。 ーー 質問のコードではE,F,G3列に B1:D3の 1 2 3 3 8 5 1 3 4 を順次下行方向に貼り付けていっているがそれで良いのか。 質問のコードでもセルの値が7以上の数が現れたら処理を抜けたが。 例データ 質問異は例データをあげよ。プログラムはデータとコードの相互(対)関係で問題化する場合がおおいのだ。 1 2 3 3 8 5 1 3 4 これでやってみると 結果 1 2 3 3 8 5 1 3 4 1 2 3 3 8 5 1 3 4 1 2 3 3 8 5 1 3 4 1 2 3 3 8 5 1 3 4 でおかしくないのでは?
お礼
たいへん勉強になりました。 ありがとうございます。
- okormazd
- ベストアンサー率50% (1224/2412)
プログラム自体は問題なく動作します。 ただ、質問者の意図したようには動かなかったとすれば、なにか勘違いをされていると思います。 B1:D3のどれかが7を超えたらというのであれば、それをチェックしているのが、B1から順番にやっているので、 すでにチェックが済んだセルの数式が、7を超える計算になるなら、7を超えてもぬけられないことになる。 だから、毎回B1:D3のチェックを改めてする必要があります。 質問者のコードを尊重すれば、次のようなものになります。 Sub test() Dim i As Range Dim n As Long Dim x As Long n = 1 x = 1 While x Range("A1").Value = x For Each i In Range("B1:D3") If i < 7 Then MsgBox i.Address & Chr(10) & i Range("B1:D3").Copy Cells(n, 5).Select Selection.PasteSpecial Paste:=xlPasteValues ElseIf i > 7 Then MsgBox i.Address & Chr(10) & i Exit Sub End If Next n = n + 3 x = x + 1 Wend End Sub
お礼
参考になりました。 ご丁寧にありがとうございます。
- mshr1962
- ベストアンサー率39% (7418/18948)
>セルB1~D3までのセルの値(9つ)が、7を超えない条件 iの内容はB1:D3のセルの内容ですが 1週目はB1,2週目はB2と比較するセルはひとつだけです。 つまり該当の1セル以外は判定していません。 比較する対象のセルがB1:D3内のすべてのセルということであれば For Each ・・Next文は不適当ですね。 一例ですが Sub test() Dim i As Range Dim n As Long Dim x As Long n = 1 x = 1 y = 0 Do While y < 7 Range("A1").Value = x y = Application.WorksheetFunction.Max(Range("B1:D3")) If y < 7 Then Range("B1:D3").Copy Cells(n, 5).Select Selection.PasteSpecial Paste:=xlPasteValues n = n + 3 x = x + 1 End If Loop End Sub
お礼
たいへん勉強になりました。 ありがとうございます。
- keithin
- ベストアンサー率66% (5278/7940)
ちがいますか sub macro1 ’一個でも7を超えるまで「A1に」1加算を繰り返す do range("A1") = range("A1")+1 ’抜けるまで転記する range("E65536").end(xlup).offset(1).resize(3, 3).value = range("B1:D3").value loop until application.countif(range("B1:D3"), ">7") >0 end sub といった具合で。 #A1+1するところから入るので,「初期値」は意図した初期値の一つ前の数字から始めます。
お礼
ご連絡が遅れ、申し訳ございません。 シンプルなコードで参考になりました。 ありがとうございます。
- keithin
- ベストアンサー率66% (5278/7940)
sub macro1 ’一個でも7を超えるまで「A1に」1加算を繰り返す do until application.countif(range("B1:D3"), ">7") >0 range("A1") = range("A1")+1 loop ’抜けたら転記する range("E65536").end(xlup).offset(1).resize(3, 3).value = range("B1:D3").value end sub と言った具合で。
- jcctaira
- ベストアンサー率58% (119/204)
DT7さん プログラムは問題はないと思いますが…。 試しにB1セルに9が入っていれば、コピーしないですぐに終わりました。 何か勘違いしているのではないでしょうか? ※1ステップ実行(F8キー)すればプログラムの流れが分かると思います。
お礼
ご連絡ありがとうございます。 おかしいと思った時はステップ実行をすればよいということですね。
関連するQ&A
- エクセル2003のVBAで列を指定
エクセルで特定の列の2~10行目に対して、ある作業をする場合、列を指定する方法は以下のどれがいいでしょうか?あるいはもっといい方法があれば教えてください。 実際には列は約40列(固定)、行は1~2万行(変動)程度で、作業はもっと複雑です。 Sub test01() Dim col Dim i As Long, n As Long For Each col In Array(1, 3, 7, 8, 11) '列番号で指定 For i = 2 To 10 n = n + 1 Cells(i, col).Value = n Next i Next col End Sub Sub test02() Dim col Dim i As Long, n As Long For Each col In Array("A", "C", "G", "H", "K") '列の記号で指定 For i = 2 To 10 n = n + 1 Cells(i, col).Value = n Next i Next col End Sub Sub test03() Dim col Dim i As Long, n As Long For Each col In Range("A2,C2,G2,H2,K2") 'セルで指定 For i = 2 To 10 n = n + 1 col.Offset(i - 2).Value = n Next i Next col End Sub
- ベストアンサー
- その他MS Office製品
- excel vbaについてです
VBA初心者で、暇な時にいろいろためしています。 以下のマクロを組んだのですが、エラーがでてうまくいきません。 どこがいけないのかご指摘願います。 Sub ather() Dim A As Range Dim B As Range Dim i As Integer With ThisWorkbook.Worksheets("Sheet1") For i = 1 To 30 Set A = Cells(i, 1) Set B = Cells(1, i) If Not .Range(A).Interior.ColorIndex = vbYellow Then GoTo port10 If Not .Range(B).Interior.ColorIndex = vbRed Then GoTo port10 .Range(B).Offset(, 1).Value = "○" port10: Next i End With End Sub イメージとしてはセルの塗りつぶしが黄色で、かつ右隣のセルの塗りつぶしが赤の時に、 赤色セルの右隣のセルに○を表示させようとしているのですが。。。 こうしたらいいんじゃない?といったアドバイスもお願いします(-人-)
- ベストアンサー
- その他MS Office製品
- 指定したセルに1がない時、For を抜けたいのですが・・・
Office XP Personal 2002 Excel 2002 指定した範囲セルに1がない時、下記の1つの For だけ を抜けたいのですが・・・ どのように変更すればよろしいでしょうか? よろしくお願い致します。 Sub test() Dim i As Integer Dim n As Range For i = 1 To Worksheets.Count - 1 Worksheets(i).Activate For Each n In .Range("E6", .Range("E6").End(xlDown)) If Not n.Cells.Value = 1 Then End If Next n MsgBox "「1」 がありません。", 48 Exit For 'For Each n In .Range("E6", .Range("E6").End(xlDown)) '続く '・ '・ End Sub
- ベストアンサー
- オフィス系ソフト
- エクセルVBAについて
現在、エクセル2010を使用し文字色が黒だったら1と加算しそれ以外は0というVBAを VBA素人ながら、コピペしながら組んでいました。 以下 'ColorIndex = 1 は、黒です 3は赤 黄色は7 青は 5 '============================================ Function fcolor(a As Range, b As Integer) Dim c As Range, cu As Integer, frg As String Application.Volatile For Each c In a With c.Font If b = 1 Then If .Color = vbBlack Then cu = cu + 1 Else If .ColorIndex = b Then cu = cu + 1 End If End With Next fcolor = cu End Function という風にし、範囲を=fcolor(D3:E37,1)としていますが、 本当なら”0”と表記されるべきなのですが”66”となってしまいます。 VBAど素人なのでよろしくお願いします。
- 締切済み
- オフィス系ソフト
- エクセル VBA もっときれいな書き方?
Sub test() Dim i As Integer, n As Integer n = 1 For i = 2 To 150 If Cells(i, 1) <> Cells(i - 1, 1) Then Cells(i - 1, 5) = i - n Cells(i - 1, 6) = Application.WorksheetFunction.Sum(Range("B" & n & ":" & "B" & i - 1)) n = i End If Next i End Sub 上記のマクロですが Application.WorksheetFunction.Sum(Range("B" & n & ":" & "B" & i - 1)) この部分、もっとスマートに書く方法を教えてください。 Range("B" & n & ":" & "B" & i - 1)って、ちゃんと動きますが、書き方が何か変なような気がするんです。 よくわかってもいないのにすみません。
- ベストアンサー
- オフィス系ソフト
- 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 カウンタ2つを入れ子にしたくない時
皆さんこんにちは。 エクセル2013を使用しております。 エクセルVBAの繰り返し処理について質問させていただきます。 下記のコードですと入れ子があるので A1にi、A3にi・・・・を一通り記載したあと またA1にi+2、A3にi+2・・・を繰り返し 最終的にA列には全て同じ値が入ってしまいます。 (Step 2にしたのはA1:A2のように2行毎の結合セルだからです) ----------------------------------------------------------------- Dim i As Long Dim j As long Dim n As long Dim k As long i =Userform.textbox1.value j =Userform.textbox2.value For k =i To j Step 2 For n = 1 to j Step 2 Range("A" & n) = k Range(”B”&n)=k+1 Next Next ---------------------------------------------------------- もしiが1、jが10だとしたら A1に1、B1に2、A3に3、B3に4、・・・A9に9、B9に10 が入るようにするにはどうしたら良いでしょうか。 iが必ず1から始まるのであればまだ分かるのですが そうとも限らないので カウンタはやはり2つ必要だと思うのですが カウンタが2つあるのに入れ子にしないコードの書き方って あるのでしょうか。 いくら本やネットを見ても分かりません。 ご教授いただけると幸いです。
- ベストアンサー
- Excel(エクセル)
- エクセルVBAのエラー
よろしくお願いします。 VBA初心者のものです。 下記のコードを作成しましたが、 アプリケーション定義?がされていません というエラーが出ます。 わかりやすく教えていただけないでしょうか。 修正方法を教えてください。 0901名簿.xlsという名前の ファイルAのsheet1の 情報(ファイルBのセルBD1に日付4桁が記入されている)を ファイルBのセルA1の情報を元にファイルBのセルB1に抽出したい Sub 関数の挿入() Dim i As Long Dim あ As String Dim い As String Dim う As String あ="=VLOOKUP(A1,[" い=Range("BD1") う="名簿.xls]Sheet1!$F:$I,1,0)" For i = 2 To 50 Range("A" & i )= あ & い & う Next i End Sub
- ベストアンサー
- オフィス系ソフト
- vba 曜日のデータ
どなたか教えて頂ければ幸いです。 以下のようなコードがあります。これは、1~31迄の日付シートに あらかじめ用意されている日~土までの曜日シートの内容を 自動的にコピーしようとしているものです。 日付シートのB5には weekday()関数とユーザー定義の書式のaaaにより 日曜日なら「日」、月曜日なら「月」が入っています。 ですが、下の「<------」の箇所は、エラーではありませんが、 一致確認がなされていません。weekday()関数の戻り値を文字列と して見ていないのでしょうか? Sub test() Dim ws As Worksheet Dim i As Integer For Each ws In Worksheets For i = 1 To 31 If ws.Name = CStr(i) Then ws.Select If ws.Range("B5") = "日" Then <----- Worksheets("日").Range("A1:D3") _ .Copy Destination:=ws.Range("A7") ws.Tab.ColorIndex = 45 ElseIf ws.Range("B5") = "月" Then <----- Worksheets("月").Range("A1:D3") _ .Copy Destination:=ws.Range("A7") ws.Tab.ColorIndex = xlNone
- ベストアンサー
- オフィス系ソフト
- VBA(エクセル)でのCOUNTAについて
エクセルのSheet1のB列にSheet2の内容をコピーして、(ここまではできました) Sheet1のB列に入ってきたデータの横(A列に)連番を振りたいと思っています。 そのため、以下のように作ってみたのですが、 A列に表示される連番が現在のB列の最後の数“54”をA列全て(B列にデータがあるところ)に表示してしまいます。 どの部分が悪いのかさっぱりわからず、どのように修正すべきかもわからず・・・困ってしまっています。 よろしくお願いします。 Dim i As Range Dim mycount As Range Set mycount = Application.Intersect(Target, Me.Range("b:b")) If mycount Is Nothing Then Exit Sub End If Application.EnableEvents = False For Each i In mycount If IsEmpty(i.Value) Then i.Offset(0, -1).ClearContents Else i.Offset(0, -1).Value = Application.WorksheetFunction.CountA(Range("b2:b200")) End If Next i Application.EnableEvents = True End Sub
- ベストアンサー
- オフィス系ソフト
お礼
朝早くから早速のご連絡ありがとうございます。 瞬時に解決することができました。