エクセル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

お手数ですが、宜しくお願いいたします。

回答No.1

KURUMITO · ベストアンサー

i をすべて　iRange に変えてみてください。

お礼

朝早くから早速のご連絡ありがとうございます。
瞬時に解決することができました。

回答No.7

imogasi

初心者はコードをそのまま載せるのでなく。やりたいことを、文章で説明すべきだ。本件ではないが、思いついたロジック（処理方法）が途方も無いものがあるので。
＞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の各セルを１セルつづつとらえる。
iが７を超える場合は、そこで処理を打ち切るのか、そのセルだけ処理を飛ばすのかはっきりしない。
打ち切りなら
Sub test1()
For Each i In Range("B1:D3")
MsgBox i.Address & " " & i
If i > 7 Then Exit For
Next
End Sub
をやって、質問者のコードと比べて、考えてみたら。
７の場合の処理が質問でははっきりしない。コード上も抜けている？
Sub test1()
For Each i In Range("B1:D3")
MsgBox i.Address & " " & i
If i > 7 Then Exit For
（コピー貼り付け処理）
Next
End Sub
nは整数で良いのでは。２００７か。エクセルバージョンぐらい書くこと。
ーー
質問のコードではE,F,G３列に
B1:D3の
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
1 2 3
3 8 5
1 3 4
でおかしくないのでは？

お礼

たいへん勉強になりました。
ありがとうございます。

回答No.6

okormazd

プログラム自体は問題なく動作します。
ただ、質問者の意図したようには動かなかったとすれば、なにか勘違いをされていると思います。

B1:D3のどれかが７を超えたらというのであれば、それをチェックしているのが、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

お礼

参考になりました。
ご丁寧にありがとうございます。

回答No.5

mshr1962

＞セル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

お礼

たいへん勉強になりました。
ありがとうございます。

回答No.4

keithin

ちがいますか

sub macro1
　’一個でも７を超えるまで「Ａ１に」１加算を繰り返す
　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するところから入るので，「初期値」は意図した初期値の一つ前の数字から始めます。

お礼

ご連絡が遅れ、申し訳ございません。
シンプルなコードで参考になりました。
ありがとうございます。

回答No.3

keithin

sub macro1
　’一個でも７を超えるまで「Ａ１に」１加算を繰り返す
　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

と言った具合で。

回答No.2

jcctaira

DT7さん　
プログラムは問題はないと思いますが…。
試しにB1セルに9が入っていれば、コピーしないですぐに終わりました。

何か勘違いしているのではないでしょうか？
※１ステップ実行（F8キー）すればプログラムの流れが分かると思います。

お礼

ご連絡ありがとうございます。
おかしいと思った時はステップ実行をすればよいということですね。