[[20150520182154]]　『レコードのコピーについて。』（ヤイリ）　ページの最後に飛ぶ

『レコードのコピーについて。』（ヤイリ）

 Ａセル　　Ｂセル
 ht001      1
 ft001      1

 Ａセル　　Ｂセル
 ht001      1
 ht001      1
 ht001      1
 ht001      1
 ht001      1
 ft001      1
 ft001      1
 ft001      1
 ft001      1
 ft001      1

上記のように１レコードごとのデータを
５レコードコピーしたり
10レコードコピーしたり
エクセル上で、できないでしょうか？
レコード数が多いので
手動ですと時間がかかってしまいます。
プログラムを作成しなければ
厳しいでしょうか。
どうぞよろしくお願いします。

＜使用 Excel：Excel2010、使用 OS：Windows7 ＞

Sub main()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Set sh1 = Worksheets("sheet1")
Set sh2 = Worksheets("sheet2")
d = sh1.Range("A65536").End(xlUp).Row

k = 1
For i = 1 To d
For j = 1 To sh1.Cells(i, "C")
sh1.Range(sh1.Cells(i, "A"), sh1.Cells(i, "C")).Copy _
sh2.Cells(k, "A")
k = k + 1
Next j
Next i
End Sub

調べたらＣセルにコピーしたい
数値を用意して
対応出来ました。
また何かありましたら
宜しくお願い致します。

（ヤイリ） 2015/05/20(水) 19:47

Resizeを使うと、こんな書き方もできます。

 Option Explicit

 Sub main()
    Dim sh1 As Worksheet
    Dim sh2 As Worksheet
    Dim d As Long
    Dim k As Long
    Dim i As Long
    Dim コピー数 As Long

    Set sh1 = Worksheets("sheet1")
    Set sh2 = Worksheets("sheet2")
    d = sh1.Range("A65536").End(xlUp).Row

    k = 1
    For i = 1 To d
        コピー数 = sh1.Cells(i, "C").Value
        sh1.Cells(i, "A").Resize(, 3).Copy _
            sh2.Cells(k, "A").Resize(コピー数)
        k = k + コピー数
    Next i

 End Sub

（マナ） 2015/05/20(水) 23:24

提示いただいた処理の方が、断然速いです。
参考になりました。
どうもありがとうございました。
（ヤイリ） 2015/05/21(木) 08:16

コメント返信：

[ 一覧(最新更新順) ]

[[20150520182154]] 『レコードのコピーについて。』（ヤイリ） ページの最後に飛ぶ

[[20150520182154]]　『レコードのコピーについて。』（ヤイリ）　ページの最後に飛ぶ