| |
Sora さん、G-Luckさん、こんばんは。
>初めての質問になります。
>お手数をお掛け致しますがよろしくお願い致します。
>
>現在、Excel2000を使用して下記のようなリストを作っています。
>下記のデータ(Sheet1)をSheet2に次の条件で複写したいのですが
>どのようにすればよいでしょうか？
>
>条件：Sheet1の各列のデータを"O"の値の数だけSheet2にコピーする。
>
><Sheet1>
> A B 〜 N O
>1 月日 品目 伝票No 数量
>2 10/01 棚 〜 伝票1 3
>3 11/03 机 〜 伝票2 5
>4 11/13 椅子 〜 伝票3 3
>
>
><Sheet2>（複写後にこのようになるようにしたいのですが…）
> A B 〜 N O
>1 月日 品目 伝票No 数量
>2 10/01 棚 〜 伝票1 1/3
>3 10/01 棚 〜 伝票1 2/3
>4 10/01 棚 〜 伝票1 3/3
>5 11/03 机 〜 伝票2 1/5
>6 11/03 机 〜 伝票2 2/5
>7 11/03 机 〜 伝票2 3/5
>8 11/03 机 〜 伝票2 4/5
>9 11/03 机 〜 伝票2 5/5
>10 11/13 椅子 〜 伝票3 1/3
>11 11/13 椅子 〜 伝票3 2/3
>12 11/13 椅子 〜 伝票3 3/3
>
以下のコードは、Sheet1からSheet2にＡ列からＮ列までは値のみコピーしています。
よって、Sheet2のＡ列からＮ列は、適当な書式を設定して置いてください。
'================================================================
Sub test()
Dim sht1 As Worksheet
Set sht1 = Worksheets("sheet1")
odx = 2 'sheet2の書き込み行
For idx = 2 To sht1.Cells(sht1.Rows.Count, 1).End(xlUp).Row
'↑idxは、Sheet1の行
With Worksheets("sheet2")
repcnt = sht1.Range("o" & idx).Value
'↑繰り返し数の取得
.Range(.Cells(odx, 1), .Cells(odx + repcnt - 1, 14)).Value = _
sht1.Range(sht1.Cells(idx, 1), sht1.Cells(idx, 14)).Value
'A列からN列はそのまま代入
s_add = .Range("o" & odx).Address
'sheet2のＯ列の書き込みセルの絶対アドレス
With .Range(.Cells(odx, 15), .Cells(odx + repcnt - 1, 15))
.NumberFormat = "0""/" & repcnt & """"
.Formula = "=(row()-row(" & s_add & ")+1)"
.Value = .Value
End With
odx = odx + repcnt
End With
Next idx
End Sub
悩んだのは、Sheet2のＯ列の書式をどうしようかと思いましたが・・・。
数量が文字列というのもなあと思い、数字を残しておきました。
確認して下さい。
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
