Excel VBAで条件付のコピーをしたい

質問

A列には顧客コード、B列には申込口数があり、別のシートにA列の顧客コードをB列の申込口数分コピーをしたいのですが、Do Loopの使い方がイマイチわからないので、どなたがご教授願います。Win2000 Excel2002です。

回答No.1

snoopy64 · ベストアンサー

コピー元がSheet27、コピー先がSheet28、
A1、B1にはタイトルが入っているとします。

Sub mousikomi()
Dim wsi As Worksheet
Dim wso As Worksheet
Set wsi = Worksheets("Sheet27")
Set wso = Worksheets("Sheet28")
Dim i As Long
Dim j As Long
Dim k As Long
k = 1
For i = 2 To 65536
If Len(wsi.Cells(i, 1).Value) = 0 Then Exit For
For j = 1 To wsi.Cells(i, 2).Value
k = k + 1
If k > 65536 Then Exit For
wso.Cells(k, 1).Value = wsi.Cells(i, 1).Value
Next
If k > 65536 Then Exit For
Next
Set wsi = Nothing
Set wso = Nothing
End Sub

頑張ってくださいヽ(^。^)ノ

補足

すごいです！出来ました！
Do Loopを使用するのかと思っていましたが、どうにも初心者の為、どこでうまく申込数分コピーされているのかわかりません。お手数ですが、For j=1からの意味が良くわからないので教えてください。本当にすいません。

回答No.3

imogasi

Sub test01()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Set sh1 = Worksheets("sheet1")
Set sh2 = Worksheets("sheet2")
sh1.select
k = 1
For i = 1 To 10 '最終行数に置き変える
　For j = 1 To sh1.Cells(i, "B")
　　sh2.Cells(k, "A") = sh1.Cells(i, "A")
　　k = k + 1
　Next j
Next i
End Sub
繰り返し回数がＢ列に出ているのでＤｏＬｏｏｐより
ＦｏｒＮｅｘｔの方がベター。

回答No.2

snoopy64

#1です。
うまく動いてくれてなにより一安心です(^^ゞ
もちろん、Do Loopを使う方法もありですよね。
同じ事をするのにも、何通りもありますからね。
いろいろ試してみることで幅が広がると思いますよ。

さて、ご質問がありましたので、簡単に説明します。
For j = 1 To wsi.Cells(i, 2).Value
は、jの値を変化させながらのループです。
初期値=1
終了値=wsi.Cells(i, 2).Value
です。
wsi.Cells(i, 2).Valueは、コピー元シートのi行目の2（B）列の値です。申込口数が入っていますよね。
ですから、3口であれば、
コピー先シートの行位置（k）に1を足して、
そこにコピー元の顧客コードを入れる。
これを3回繰り返すわけです。
ちなみに口数が0の場合は、最初から終了値が初期値をこえていますので、結果的に何もしません。
EXCELの行数は65536が最大なので、これを超える行位置に達したときは処理を抜けるようにしています。
頑張ってください(^o^)丿

お礼

わかりやすい説明どうもありがとうございます！
また何かありましたら今後もよろしくお願いします