| |
▼ひらた さん：
ごめんなさい。
↑は、一挙に行挿入をしていますが、行数が多くなればエラーになりますね。
とりあえず以下に変更します。
ただ、１万行でテストしましたら私の環境で１５秒もかかっていますので
あまり、いいコードではないですが。
Sub Sample2()
Dim v() As String
Dim i As Long, z As Long
Dim c As Range
Application.ScreenUpdating = False
With Worksheets("Sheet1") '<== 実際のシート名に
z = .Range("A" & .Rows.Count).End(xlUp).Row
ReDim v(1 To z * 2, 1 To 3)
i = 1
For Each c In .Range("A1").CurrentRegion.Resize(, 1)
v(i, 1) = c.Value
v(i, 2) = c.Offset(, 1).Value
v(i + 1, 2) = c.Offset(, 2).Value
i = i + 2
Next
.Range("A1").Resize(z * 2, 3) = v
z = .Range("A" & .Rows.Count).End(xlUp).Row
For i = 1 To z Step 2
.Range("A" & i).Resize(2).MergeCells = True
Next
End With
Application.ScreenUpdating = True
End Sub
|
|
UO3
- 10/9/7(火) 19:18 -
