IF・DoなどＶＢＡについて

質問

部品の在庫に対する発注数を算出するプログラムを下記の条件で作成中です。
ご指導願います。
A・B・Cの3種類の機械があり、それぞれ2種類の部品を持っています。
A・B・Cの3種類の機械があり、それぞれ指定した残量になると発注数を算出する。
1.Aの限界在庫
box1:50000
box2:5000
2.Bの限界在庫
box1:40000
box2:4000
3.Cの限界在庫
box1:30000
box2:3000

4Aの発注基準値
box1:30000
box2:3000
5.Bの発注基準値
box1:20000
box2:2000
6.Cの発注基準値
box1:10000
box2:1000

7.発注基準値の切り捨て
　1の単位までありますので下記の単位で切り捨てます。
box1:10の単位で切り捨て
box2:10の単位で切り捨て

8.A列にA・B・Cの機械の識別IDがランダムにあります。
9.B列にbox1の在庫があります。
8.C列にbox2の在庫があります。
8.Ｄ列にbox1の在発注数を表示します。。
8.Ｅ列にbox1の在発注数を表示します。

Sub 計算1()
Dim i As Integer
Dim Abox1, Abox2, Bbox1, Bbox2, Cbox1, Cbox2 As Long
Dim Aboxh1, Aboxh2, Bboxh1, Bboxh2, Cboxh1, Cboxh2 As Long

Abox1 = 50000 'Abox1容量
Abox2 = 5000 'Abox2容量
Bbox1 = 40000 'Bbox1容量
Bbox2 = 4000 'Bbox2容量
Cbox1 = 30000 'Cbox1容量
Cbox2 = 3000 'Cbox2容量

Aboxhk1 = 30000 'Abox1発注基準値
Aboxhk2 = 2000 'Abox2発注基準値
Bboxhk1 = 20000 'Bbox1発注基準値
Bboxhk2 = 2000 'Bbox2発注基準値
cboxhk1 = 10000 'Cbox1発注基準値
cboxhk2 = 1000 'Cbox2発注基準値

Aboxhs1 = 30000 'Abox1発注数
Aboxhs2 = 2000 'Abox2発個数
Bboxhs1 = 20000 'Bbox1発個数
Bboxhs2 = 2000 'Bbox2発個数
cboxhs1 = 10000 'Cbox1発注数
cboxhs2 = 1000 'Cbox2発注数

i = 2
Aboxhs1 = Abox1 - Cells(i, 2)
Aboxhs2 = Abox2 - Cells(i, 3)
Bboxhs1 = Bbox1 - Cells(i, 2)
Bboxhs2 = Bbox2 - Cells(i, 3)
cboxhs1 = Cbox1 - Cells(i, 2)
cboxhs2 = Cbox2 - Cells(i, 3)

Do While Worksheets("sheet1").Cells(i, 1) = "A"
If Cells(i, 2) < Aboxhk1 Or Cells(i, 3) < Aboxhk2 Then
Worksheets("sheet1").Cells(i, 4) = Application.WorksheetFunction.RoundDown(Aboxhs1, -3)
Worksheets("sheet1").Cells(i, 5) = Application.WorksheetFunction.RoundDown(Aboxhs2, -2)

End If
i = i + 1
Loop

Do While Worksheets("sheet1").Cells(i, 1) = "B"
If Cells(i, 2) < Bboxhk1 Or Cells(i, 3) < Bboxhk2 Then
Worksheets("sheet1").Cells(i, 4) = Application.WorksheetFunction.RoundDown(Bboxhs1, -3)
Worksheets("sheet1").Cells(i, 5) = Application.WorksheetFunction.RoundDown(Bboxhs2, -2)

End If
i = i + 1
Loop

Do While Worksheets("sheet1").Cells(i, 1) = "C"
If Cells(i, 2) < cboxhk1 Or Cells(i, 3) < cboxhk2 Then
Worksheets("sheet1").Cells(i, 4) = Application.WorksheetFunction.RoundDown(cboxhs1, -3)
Worksheets("sheet1").Cells(i, 5) = Application.WorksheetFunction.RoundDown(cboxhs2, -2)

End If
i = i + 1
Loop

End Sub

回答No.1

bin-chan · ベストアンサー

コメントを書く習慣をつけたほうが良いですよ。

Loopでループ終了後、iをリセットしてないので、対象行は延々と下がり続けるように見えます。

'---現 ここから
i = i + 1
Loop

Do While Worksheets("sheet1").Cells(i, 1) = "B"
'---現 ここまで

'---新 ここから
i = i + 1
Loop

’iをリセットする
i =　2
Do While Worksheets("sheet1").Cells(i, 1) = "B"
'---新 ここまで

お礼

お礼が遅くなり、申し訳ありません。
ありがとうございまた。
アドバイスを参考に試行錯誤の結果、完成しました。
今後もお願いします。

補足

回答ありがとうございます。
すみませんが、初心者のためよくわかりませんのでもう一度教えてください。
Ａ列には、いくつものABCが不規則に並んでいるために、はじめのAは処理できますが、Bになると処理されません。
勉強不足で、すみませんが、ご指導願います。