Excelで、「あるセル」に入力されている数値の分だけ、その行を複製コピーするVBAスクリプト。
例えば、こういう場合に使う。
| A | B | C | D | |
| 1 | 商品名 | 個数 | シリアル番号 | |
| 2 | ○○○ | 10 | ||
| 3 | △△△ | 5 |
商品1個ずつシリアル番号が必要なため、個数の数だけ行を増やした後、「シリアル番号」を連番入力するという風な作業をしたい時。 手で行コピー、張りつけを繰り返すよりは、スクリプトで自動化…
Sub test1()
Dim i As Integer
Dim nTemp As Integer
Dim nEmptyLine As Integer
nEmptyLine = 0
For i = 1 To 10000
If TypeName(Cells(i, "B").Value) = "Empty" Then
'個数セルが『空白』の場合、空白カウンタをインクリメント
nEmptyLine = nEmptyLine + 1
'『空白』が4行以上続いたら、処理中断
If nEmptyLine > 3 Then
Exit For
End If
Else
'空白カウンタをリセット（『空白』以外のセルが出現したため）
nEmptyLine = 0
'個数セルの内容を数値に変換して一時変数に代入
nTemp = Val(Cells(i, "B").Value)
If nTemp > 1 Then
'行コピー
Range(Rows(i), Rows(i)).Copy
'行挿入＆ペースト
Range(Rows(i), Rows(i + nTemp - 1)).Insert
'挿入行数分だけ、処理行を進める
i = i + nTemp
End If
End If
Next i
End Sub
※ 閲覧者からの指摘がありました。意図した行数＋１行コピーされてしまうようです。Excelの実環境を持っていないので、検証不可です、すいません。（２０１６年９月追記）
