| |
こんにちわ。
ループで行の挿入や削除をやるときは、下からやったほうが簡単やと思うんやけど・・・
で、数式入れる方法で一案考えてみました。
結果は新しいシートを追加してそこに書き出してます。
Sub test()
Dim i As Long
Application.ScreenUpdating = False
ActiveSheet.Copy ActiveSheet
For i = Range("A65536").End(xlUp).Row To 2 Step -1
If Cells(i, 2).Value > 1 Then
Rows(i).Copy
Range(Rows(i + 1), Rows(i + Cells(i, 2).Value - 1)).Insert
End If
Next
Range("C2").Value = 1
With Range(Cells(3, 3), Range("A65536").End(xlUp).Offset(0, 2))
.Formula = "=IF(A3=A2,C2+1,1)"
.Value = .Value
End With
Range("A1:B1").AutoFill Range("A1:C1")
Application.ScreenUpdating = True
End Sub
Ｃ１の項目名がＡ１：Ｂ１のオートフィルでは具合悪いんやったら、
直接指定してください。
試してみてな。
ほな。
|
|
ｂｙｋｉｎ
- 05/1/30(日) 18:34 -
