VBA 繰り返し処理に追加条件を入れたい

質問

Excel2003を使用しております。
下記の様なA～Dの内容をE～Hに生産指示伝票用に
バラしてコピーしています。
単品の事だけを考えており、SET品の場合の事を
考えておりませんでした。
条件による分岐を行うにはどうすればよいのか御教授下さい。

Dim FromRow As Integer 'コピー前の行番号
Dim ToRow As Integer 'コピー先の行番号
Dim Num As Integer '現在転記中の残りの個数
FromRow = 2 '元の表のデータの最初の行番号
ToRow = 2 '転記先の最初の行番号
'メインループ
Do While Cells(FromRow, "A").Value <> ""
Num = Cells(FromRow, "D").Value '個数を取得
Do While Num > 0
Cells(FromRow, "A").Resize(2, 4).Copy Cells(ToRow, "E") 'A～C列をE列にとりあずコピー
If Num >= 1 Then
Cells(ToRow, "H").Value = 1 '2以上だったらコピー先の個数を1に置きかえ
Else
Cells(ToRow, "H").Value = Num '1未満だったらその数に置きかえ
End If
Num = Num - 1
ToRow = ToRow + 1
Loop
FromRow = FromRow + 1
Loop

上記のVBAだと、セット品も1としてコピーされるだけなので、
セット品の場合のみ、別シートのSET品マスタから下記の様に
読み込める様にしたいと考えております。

区分 商品名 色 数量 区分 商品名 色 数量
単品 ボールペン ブルー 1 単品 ボールペン ブルー 1
単品 ボールペン レッド 2 単品 ボールペン レッド 1
SET Aセット レッド 2 単品 ボールペン レッド 1
単品 色鉛筆 ブルー 2 SET 色鉛筆 レッド 1
単品 色鉛筆 レッド 3 SET ボールペン レッド 1
SET Bセット 黒 2 SET 色鉛筆 レッド 1
SET ボールペン レッド 1
単品 色鉛筆 ブルー 1
単品 色鉛筆 ブルー 1
単品 色鉛筆 レッド 1
単品 色鉛筆 レッド 1
単品 色鉛筆 レッド 1
SET マジック 黒 1
SET ボールペン 黒 1
SET マジック 黒 1
SET ボールペン 黒 1

VBAについてまだまだ勉強不足ですが
使いながら学んで行きたいと考えていますので
よろしくお願いいたします。

回答No.1

layy · ベストアンサー

答えでもないので、参考です。

数量の展開とセット品の展開があるので、
それを同時に進行するやり方
数量の展開をおこなって、その後でまたループしてセット品の展開、２段階でおこなうやり方
と２通りあると思います。
後者をまずやってみて前者へ整形するのもありかと思います。

セット品の時のほかシートを参照して・・・、というのに困っていますか？。

セット品の商品情報のシートを
事前に読み込んで配列に待避しておいてから今回の編集を操作すれば、
単品はシート値そのままで展開、セット品の商品の展開は配列を見て展開、
とできるように思いますが、それに耐えうる商品数かがわかりません。

それか
存在するセット品を単品レベルに展開させておけば
今のロジックが使えるようにも思えます。

条件分岐というよりは、どのタイミングでセット品の展開をおこなうか、
そんな感じかと思います。

お礼

申し訳ございません！！
質問を締め切った際、お礼したつもりでいましたが、
今、改めて確認し、お礼がまだだった事に気が付きました。

改めて御礼申し上げます。

誠に失礼致しました。