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についてまだまだ勉強不足ですが
使いながら学んで行きたいと考えていますので
よろしくお願いいたします。
お礼
スノピも別だったのですか。それならちょうどいいのがあります。 それにしてもさすがにいいお値段しますね。 同じぐらいのサイズでもロゴスなどの安いセットなら5つぐらい買えちゃいそうです。 でもまあ奮発してブランドバリューと信頼性や高品質をとるか。 5/1の値段でポールなど不要な付属品を我慢するか。 非常に悩むところです。そもそもブランドは気にしない派なので・・・ 質問で書いたナチュラムのタープで、倍の大きさのものを作ってくれればベストなんですがねえ。