合計数量から引いていく

ｖｂａをネットで検索しながら作成しているのですが、うまくいかず困っています。
お助けいただけたら嬉しいです。

やりたいことは、Ｙ列「複数ロットＮｏ」が空白ではない場合、Ｑ列の「合計数量」を分割していく。
言い換えると、同じ入荷ＮＯ（Ｆ列）のものを、予定使用数（Ｚ列）に合わせて実際使用数（ＡＡ列）に分割していく。
※添付図面の左から右にしたいです。右図に追加したものは、わかりやすく赤字にしてあります。

①Ｙ列が「1」の場合、Ｑ列とＺ列を比較する。Ｚ列が大きければ、Ｑ列の値をＡＡ列に転記。
②Ｙ列が「1」で、Ｑ列とＺ列を比較してＱ列が大きければ、Ｚ列の値をＡＡ列に転記する。
③1行下がって、Ｙ列が「2」のＺ列と、1行上のＹ列が「1」の「Ｑ列－Ｚ列」を比較する。
Ｚ列が大きければ、Ｙ列が「1」の「Ｑ列－Ｚ列」を転記。
④Ｚ列が小さければ、Ｙ列が「1」の「Ｑ列－Ｚ列」からＹ列が「2」のＺ列を引く。
合計数量が0になるまで繰り返し。数が余った場合は、同じ入荷ＮＯの最終列に加算。

ＩＦを使用して、作成してみたのですがＩＦだらけになり非常にわかりにくくなってしまいました。
複数ロットＮＯは1～5まであり、3まで作成した段階で断念しました。

いい方法があれば、ご教示いただけると助かります。

-----------------------------------------------------------------

　Dim m As Long
Dim i As Long
Dim wSG As Worksheet

With wSG

For i = 2 To lRowG
If .Cells(i, "Y").Value <> "" Then
If .Cells(i, "Y").Value = 1 Then

If .Cells(i, "Z").Value <= .Cells(i, "Q").Value Then
.Cells(i, "AA").Value = .Cells(i, "Z").Value
m = .Cells(i, "Q").Value - .Cells(i, "Z").Value

If .Cells(i, "H").Value = 2 Then
.Cells(i + 1, "AA").Value = m
ElseIf .Cells(i, "H").Value = 3 Then
If .Cells(i + 1, "Z").Value <= m Then
.Cells(i + 1, "AA").Value = .Cells(i + 1, "Z").Value
.Cells(i + 2, "AA").Value = m - .Cells(i + 1, "AA").Value
Else
.Cells(i + 1, "AA").Value = m
End If

Else
.Cells(i + 1, "AA").Value = m
End If
End If
Else
.Cells(i, "AA").Value = .Cells(i, "Q").Value
End If
End If
End If
Next i
End With

No.1 ベストアンサー 回答者： fujillin 回答日時： 2023/08/29 23:12

こんばんは

ご説明が複雑で、なさりたいことが私には理解できなかったため、勝手に以下のように解釈しました。

＞同じ入荷ＮＯ（Ｆ列）のものを、予定使用数（Ｚ列）
＞に合わせて実際使用数（ＡＡ列）に分割していく。
※ Ｆ列のNoは、同じNoが必ず連続した行にあるものと仮定しました。

・同じ入荷NoのQ列の数値を、同じNoの範囲内で以下の要領で行順に振り分ける。
　1）合計数量がZ列の値より大きい場合はZ列の数量を振り分ける
　2）Z列の値の分残っていなければ、残った数量を振り分ける
　3）同じ入荷Noに振り分けて余った数量があれば、最後の行に加算して振り分ける（添付図の77行目から推測）

※ 実データは14行目から開始しているものと解釈しました。
　（添付図より）
※ Q列、Z列の値は必ず整数値（＝Long型で扱える範囲）であるものと仮定しています。
※ Ｑ列、Z列に負の値がある場合は、符号を無視して正の値に読み替えます。
※ セル値のチェックは省略していますので、おかしな値があればエラーが発生します。


以下は、F列、Q列、Z列だけを参照して、AA列に記入する例です。
　（他の列の値は参照していません）

Sub Q_13577887()
Dim NO As String, total As Long
Dim rw As Long, tmp As Long

For rw = 14 To Cells(Rows.Count, "F").End(xlUp).Row
If Cells(rw, "F").Text <> NO Then
NO = Cells(rw, "F").Text
total = Abs(Cells(rw, "Q").Value)
End If

tmp = Application.Min(total, Abs(Cells(rw, "Z").Value))
If Cells(rw + 1, "F").Text <> NO Then tmp = total
Cells(rw, "AA").Value = tmp
total = total - tmp
Next rw
End Sub

この回答へのお礼

お返事ありがとうございます。
すごいっ。この一言に尽きます。

複雑に考えすぎて、ＩＦだらけになり何がしたいのか自分でも分からなくなってきていました。このコードはすごくシンプルにまとまっていて、レベルの違いを痛感します。まだまだ、勉強不足だなっと思いました。

本当にありがとうございました。

お礼日時：2023/08/30 05:51