|
▼やみ さん:
おはようございます
ichinoseさんの回答の通り、まずは、基本的なループの中で、必要行数の挿入、コピーを行うコードを作り
その構成を習得されたらよろしいかと思います。
一方、データが多い場合、行の挿入、セルへのコピーでの書きこみは、結構処理時間がかかってしまいます。
このような場合、配列にできあがりイメージを作成しておいて一挙にシートに書きこむ方法も効果的です。
以下のコードは、まず基本を身につけられた後、お試し頂き参考にしてもらえれば幸甚です。
必要行数を調べるループ、次に実際の処理のためのループと、2回のループがありますが、
それでも、処理時間は、かなり短くなるはずです。
Sub Sample()
Dim c As Range
Dim vntF As Variant
Dim vntT() As Variant
Dim n As Long
Dim x As Long
Dim k As Long
Dim j As Long
Dim i As Long
'シート上のリストに1列加えたものを配列に取り込む
'追加の列には当該行のコピー後の行数を格納
vntF = Range("A1", ActiveSheet.UsedRange.Cells(ActiveSheet.UsedRange.Count).Offset(, 1)).Value
'必要行数を事前調査
For i = 1 To UBound(vntF, 1) '1行目から最終行まで
x = 1
If Len(vntF(i, 2)) > 0 Then 'データがあれば
x = x + UBound(Split(vntF(i, 2), ".")) 'コピー行用に . の数を加算
End If
vntF(i, UBound(vntF, 2)) = x 'この行の新行数
n = n + x '必要行数
Next
'コピー&転記処理
ReDim vntT(1 To n, 1 To UBound(vntF, 2) - 1) '出力用配列
For i = 1 To UBound(vntF, 1) '1行目から最終行まで
For x = 1 To vntF(i, UBound(vntF, 2))
k = k + 1
For j = 1 To UBound(vntT, 2)
vntT(k, j) = vntF(i, j)
Next
Next
Next
Range("A1").Resize(UBound(vntT, 1), UBound(vntT, 2)).Value = vntT
End Sub
|
|