エクセルvbaで教えてください。

Question

すみません。若輩者でどなたか教えてください。
エクセルvbaを使用して下記表がから　I列　の数値を参照して、
数値分の行コピー追加したいです。

行NO A列	B列	C列	D列	E列	F列	G列	H列	I列
1	1	名前1	名前2	100	200	300	400	500	2
2	2	名前1	名前2	10	20	30	40	50	5
2	2	名前1	名前2	-80	-160	-240	-320	-400	8
4	4	名前1	名前2	-170	-340	-510	-680	-850	1
5	5	名前1	名前2	200	300	400	500	600	4
6	6	名前1	名前2	400	500	600	700	800	6

上記　I列　の値を参照し、その値分の行数を　直ぐ下へ追加ペーストしたいです。


先日こちらで回答をいただいたのですが、行の挿入を上から順に処理したく再投稿しました。

お力添えを宜しくお願い致します。

tom04 · Accepted Answer

こんばんは！

横からお邪魔します。
https://oshiete.goo.ne.jp/qa/10637862.html
↑
のサイトの続きですね。

今回の場合行挿入の操作が必要になりますので、
他の方がおっしゃっているように行挿入（行削除）などは最終行から遡った方が間違いが少なく簡単です。

どうしても上からの操作にしたい！という場合は
別シートに表示する方法はどうでしょうか？
元データはSheet1にあり、Sheet2にコピー＆ペーストするようにしてみました。

標準モジュールです。

Sub Sample3()
　Dim i As Long, cnt As Long
　Dim myRow As Long, wS As Worksheet
　　Set wS = Worksheets("Sheet2")
　　　wS.Range("A:H").ClearContents
　　　　With Worksheets("Sheet1")
　　　　　For i = 1 To .Cells(Rows.Count, "A").End(xlUp).Row
　　　　　　If .Cells(i, "I") > 0 Then
　　　　　　　Do Until cnt = .Cells(i, "I")
　　　　　　　　cnt = cnt + 1
　　　　　　　　myRow = myRow + 1
　　　　　　　　.Cells(i, "A").Resize(, 8).Copy wS.Cells(myRow, "A")
　　　　　　　Loop
　　　　　　End If
　　　　　　　cnt = 0
　　　　　Next i
　　　　End With
End Sub

※　A～H列までをコピー＆ペーストしています。m(_ _)m

めぐみん_ · Answer

取り敢ず上（I1)からですけど、エラー処理などありませんのでダメなら・・・・・

Sub megu()
Dim r As Range

Set r = Range("I1") '開始セル

Do Until r.Value = ""
r.EntireRow.Copy
r.Offset(1).Resize(r.Value).EntireRow.Insert Shift:=xlDown
Application.CutCopyMode = False
Set r = r.Offset(r.Value + 1)
Loop

Set r = Nothing
End Sub

fujillin · Answer

こんにちは

＞行の挿入を上から順に処理したく再投稿しました
通常この手の処理は下側（行番号の大きな方）から処理するのが常道です。
（VBAをご存知のようなので、理由は考えてみてください）

上から順に処理することも不可能ではありませんが、面倒なだけです。
マクロを実行すれば、結果が出るまでは一瞬なので、結果が同じならば問題ないはずと思いますが？
それとも、処理の状況が画面上でちらっと見えるけれど、下から処理しているのが気にくわないということでしょうか？
その場合は、処理速度の向上も兼ねて、ScreenUpdatingをFalseにすれば画面のちらつきは見えなくなりますし、処理速度も速くなります。。
https://msdn.microsoft.com/ja-jp/vba/excel-vba/articles/application-screenupdating-property-excel

どうしても上から処理したいのであれば、ヒントとして・・・
　1）最初の処理すべき行数を把握（=残りの処理対象行数）
　2）処理対象の行番号のポインタを1にセット
　3）ポインタの示す行の1行分の処理を行う
　　（下側に必要な行数を挿入して記入）
　4）次の処理する対象行番号（ポインタ）を「ポインタ＋挿入行数＋1」とし、
　　 残り処理対象行数を1減ずる
　5）3）、4）を残り処理対象行数が0になるまで繰り返す
という流れに変えれば可能と思います。
（この面倒を避けるために、下から処理した方が簡単というわけです）

めぐみん_ · Answer

先の質問で回答しましたが。

現状と希望する結果の双方を記載した方が伝わりやすいと思いますよ。

naktak · Answer

Public Sub Test()
    Application.ScreenUpdating = False
    
    Dim currentRow As Integer
    currentRow = 0
    
    Do While True
        currentRow = currentRow + 1
        Dim copyLines As Integer
        copyLines = ActiveSheet.Range("I" & CStr(currentRow)).Value
        
        ' コピー行数を取得できない場合は処理終了
        If copyLines = 0 Then
            Exit Do
        End If
        
        ' 行をコピー
        currentRow = CopyRow(currentRow, copyLines)
    Loop
    
    Application.ScreenUpdating = True
End Sub

Private Function CopyRow(row As Integer, copyLines As Integer) As Integer
    Dim r As range
    
    ' コピー行数が1未満の場合は処理しない
    If copyLines < 1 Then
        CopyRow = row
        Exit Function
    End If
    
    Set r = ActiveSheet.Rows(CStr(row) & ":" & CStr(row))
    
    ' 行をコピー分追加
    Dim i As Integer
    For i = 1 To copyLines
        r.Offset(1).Insert Shift:=xlDown
    Next
    
    ' 元の行をペースト
    Dim resultRow As Integer
    resultRow = row + copyLines
    r.Copy Destination:=ActiveSheet.Rows(CStr(row + 1) & ":" & CStr(resultRow))
            
    CopyRow = resultRow
End Function

siffon9 · Answer

こんな感じ？
1行目のデータは、2行挿入されて3行のデータになります。

もし1行多い様でしたら、
　cnt = base.Offset(0, 8).Value - 1
として下さい。

Sub test()
　　Dim base As Range
　　Dim cnt As Long
　　
　　Set base = Range("A1")

Application.ScreenUpdating = False　　
　　Do While base.Value <> ""
　　　　cnt = base.Offset(0, 8).Value
　　　　Do While cnt > 0
　　　　　　Range(base, base.Offset(0, 8)).Copy
　　　　　　base.Insert shift:=xlDown
　　　　　　cnt = cnt - 1
　　　　Loop
　　　　Set base = base.Offset(1, 0)
　　Loop
    Application.ScreenUpdating = True

End Sub

tatsu99 · Answer

これは、下から順に処理したほうが楽ですよ。
上から順に処理することもできなくはないが、処理が複雑になります。
おなじ結果が得られるなら、下から順に処理したほうが良いと思いますが、上から順に処理したい理由はなぜでしょうか。

確認ですけど、１番目のデータの例なら　I列の値は２なので
1	1	名前1	名前2	100	200	300	400	500	2・・・元のデータ
1	1	名前1	名前2	100	200	300	400	500	2・・・コピーしたデータ
1	1	名前1	名前2	100	200	300	400	500	2・・・コピーしたデータ
のようになれば、良いのでしょうか。

エクセルvbaで教えてください。

こんばんは！

取り敢ず上（I1)からですけど、エラー処理などありませんのでダメなら・・・・・

こんにちは

先の質問で回答しましたが。

Public Sub Test()

こんな感じ？

これは、下から順に処理したほうが楽ですよ。

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング