| |
▼裕香 さん：
ひげくま さんのアドバイス通りに作ってみました。
アクティブシートで考えています。
Option Explicit
Sub test()
Dim i As Long
’画面更新の停止
Application.ScreenUpdating = False
’項目行が1行目にあるとして、2行目からD列の終わりの行まで
For i = 2 To Range("D" & Rows.Count).End(xlUp).Row
’もし、D列が１ではなく、E列が空白なら
If Cells(i, 4).Value <> 1 And Cells(i, 5).Value = "" Then
’その行のA列からE列までをコピーして
Cells(i, 4).Offset(, -3).Resize(, 5).Copy _
’A列の最終行の次にD列の値-1の数だけ貼り付けろ
Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(Cells(i, 4).Value - 1)
End If
’次の行へ
Next
’画面更新の再開
Application.ScreenUpdating = False
End Sub
|
|
ponpon
- 08/2/22(金) 23:04 -
