改行ごとに行を追加し、数量を分割

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

やりたいことは、①アクティブシートをコピーし、新しく追加したシートに貼り付ける。→○
②Ｆ列の納期が複数ある場合は、改行されている毎に分ける→○
③納期を分ける際に、下に行を追加する。その際、列をコピーし貼り付けて、分離された納期を記載する→×
④納期が複数ある場合、合計数量をロット単位に分ける。分けきれなかった場合は、残った数量をその品目の最後に記載。（右図　Ｅ列、15行目参照）→×

③、④が分からずご教示いただけると助かります。

----------------------------------------------------------------------------------
Sub 納期分割()
Dim a As Variant
Dim i As Long
Dim j As Long

ActiveSheet.Copy after:=ActiveSheet
ActiveSheet.Name = "New Sheet"

For j = Cells(Rows.Count, "A").End(xlUp).Row To 2 Step -1
With ActiveSheet
'改行区切りで分割
a = Split(.Cells(j, "F"), vbLf)
'配列の大きさの分だけループ
For i = 0 To UBound(a)
.Cells(j + i, "F") = a(i) 'セルへ入力
Next i
End With
Next j

End Sub

質問者からの補足コメント

• 

  補足します。
  元々添付していた図は、左図が元データ。右図がｖｂａ実行後に完成させたいデータとなります。
  しかしながら、実行後データを手入力で作成したので、間違っていました。
  
  お陰様で、①、②、③まで完成しました。添付データを再作成しました。
  「値が一致した場合、数値を合算する」はネット検索したらいくつか出てくるのですが、「値が一致したら合計数量から引いていく。」というのは見つからず困っています。
  
  やりたいことは、Ａ列（コード）が一致したら、Ｄ列（合計数量）からＣ列（ロット）を引いていく。
  ロット単位にならなかったときは、同一コードの最終行に記載する。
  （例）右図Ｅ16→2400、右図Ｅ17→2400、右図Ｅ18→3840
  
  よろしくお願いします。

  
  No.2の回答に寄せられた補足コメントです。 補足日時：2023/07/12 15:07

No.4 ベストアンサー 回答者： tatsumaru77 回答日時： 2023/07/12 17:54

No3です。

以下のマクロを標準モジュールに登録してください。

Option Explicit

Public Sub 納期分割()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim maxrow As Long
Dim row1 As Long
Dim row2 As Long
Dim srow2 As Long
Dim i As Long
Dim ndays As Variant '納期
Dim lot As Variant 'ロット
Dim goukei As Variant '合計数量
Set ws1 = ActiveSheet
maxrow = ws1.Cells(Rows.Count, 1).End(xlUp).Row
Worksheets.Add after:=ws1
Set ws2 = ActiveSheet
ws2.Name = "New Sheet"
'見出しコピー
ws2.Cells(1, 1).Resize(1, 6).Value = ws1.Cells(1, 1).Resize(1, 6).Value
row2 = 2
For row1 = 2 To maxrow
srow2 = row2
'コード～合計数量コピー
ws2.Cells(row2, 1).Resize(1, 4).Value = ws1.Cells(row1, 1).Resize(1, 4).Value
row2 = row2 + 1
ndays = Split(ws1.Cells(row1, "F").Value, vbLf)
'合計数量が空白なら次のコードへ
If ws1.Cells(row1, "D").Value = "" Then GoTo NEXT99
'納期が空白なら次のコードへ
If ws1.Cells(row1, "F").Value = "" Then GoTo NEXT99
For i = 1 To UBound(ndays)
ws2.Cells(row2, 1).Resize(1, 4).Value = ws1.Cells(row1, 1).Resize(1, 4).Value
row2 = row2 + 1
Next
'数量と納期の設定
lot = ws1.Cells(row1, "C").Value
goukei = ws1.Cells(row1, "D").Value
For i = 0 To UBound(ndays)
If i = UBound(ndays) Or lot > goukei Then
ws2.Cells(srow2 + i, "E").Value = goukei
goukei = 0
Else
ws2.Cells(srow2 + i, "E").Value = lot
goukei = goukei - lot
End If
ws2.Cells(srow2 + i, "F").Value = ndays(i)
Next
NEXT99:
Next
ws2.Range("F:F").NumberFormatLocal = "m""月""d""日"""
MsgBox ("完了")
End Sub

この回答へのお礼

お返事ありがとうございます。

できました！
色々な方法がありますね。ＶＢＡって奥が深いなと感じさせられます。
「教えてｇｏｏ」で回答してくれる方々は、皆様すごいっ！！

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

お礼日時：2023/07/12 18:27

No.3 回答者： tatsumaru77 回答日時： 2023/07/12 14:43

No2です。

＞ご指摘の通りです。
＞手入力で右図を作成したので、入力誤りしました。

ということは、下記の④のケースは存在しないということでしょうか。
8640÷2880=3 余り 0　のため下記のケースには該当しません。

④納期が複数ある場合、合計数量をロット単位に分ける。分けきれなかった場合は、残った数量をその品目の最後に記載。

この回答へのお礼

お返事ありがとうございます。

④のケースは存在します。品名「かき」がそれに該当します。
右図をＥ16→2400、Ｅ17→2400、Ｅ18→3840
としたかったです。

詳しくは、補足しました。しかしながら、画像添付したので多少時間がかかると思います。

色々とありがとうございます。

お礼日時：2023/07/12 15:13

No.2 回答者： tatsumaru77 回答日時： 2023/07/12 07:21

左図が入力データで、右図が、期待する結果という前提です。

④の件ですが、もものロットは、2880（左図）ですが、右図では、240になっています。
この240はどこから出てきたのでしょうか。
右図のC13,C14,C15は2880で、D13,D14,D15は8640、E13,E14,E15は2880が正しいと思うのですが、
いかがでしょうか。

この回答へのお礼

お返事ありがとうございます。
ご指摘の通りです。
手入力で右図を作成したので、入力誤りしました。
急いで作成したので、チェック漏れです。

お礼日時：2023/07/12 11:35

No.1 回答者： Qchan1962 回答日時： 2023/07/11 18:38

こんばんは

③についてやり方は色々ありますが　せっかく途中までトライしている
コードがあるので　掲示されているコードの処理方法を考えると

For j = Cells(Rows.Count, "A").End(xlUp).Row To 2 Step -1
下の行から処理をすると言う発想で処理しているので

＞'配列の大きさの分だけループ
も下の値（配列の要素インデックスの多きものから）から処理しないと上手くいきません

また、複数対象行を分けるわけですから行を追加する必要がありますね

追加位置は下から上なので　処理対象行の１つ下に新規行を追加してその行に対して値を入れていく　処理手順になりますね（下に押し出していく）

参考例

Sub 納期分割()
Dim a As Variant
Dim i As Long
Dim j As Long

ActiveSheet.Copy after:=ActiveSheet
ActiveSheet.Name = "New Sheet"
With ActiveSheet
For j = Cells(Rows.Count, "A").End(xlUp).Row To 2 Step -1
'改行区切りで分割
a = Split(.Cells(j, "F"), vbLf)
'配列の大きさの分だけループ
For i = UBound(a) To 0 Step -1
If i > 0 Then
'下に行を追加
.Cells(j, "F").Offset(1, 0).EntireRow.Insert Shift:=xlShiftDown
.Range(.Cells(j + 1, "A"), .Cells(j + 1, "E")).Value = .Range(.Cells(j, "A"), .Cells(j, "E")).Value
.Cells(j + 1, "F").Value = a(i) 'セルへ入力
Else
.Cells(j, "F").Value = a(i) 'セルへ入力
End If
Next i
Next j
End With
End Sub

④についてですが
上の処理の中に加える事も出来ますが少し複雑になりますので
③処理の後に処理を加えればD列の値からC列の値を
A列やB列の値を条件に比較的簡単に出来そうです
（一意でない場合があるのなら③の処理中の方が確実かもしれません）

④についてはせっかくここまで作っているので私は回答を割愛します
③の処理で出来上がったシートを見て今一度考えてみてください

この回答へのお礼

お返事ありがとうございます。
すごいっ！　③の処理うまくいきました。

行を追加するときは、下からという記憶があり下から処理をしていました。「配列の大きさの分だけループ」の方はコードに夢中になり、先の処理と整合性がとれていないことに気付きませんでした。何度か行を追加するプログラムを入れたのですが、うまくいきませんでした。

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

お礼日時：2023/07/11 19:02