エクセル 行の挿入

質問

エクセルの行の挿入方法を教えてください。
http://okwave.jp/qa1095365.html?rel=innerHtml&p=bottom&l=1
上記の質問のマクロをコピーし、少し加工して使用させていただいてます。

Sub Macro1()

Dim lngCnt As Long '処理行のカウント
Dim intCnt As Integer '挿入行数セット

''初期行セット
lngCnt = 5

'' 処理行のD列に文字がなくなるまで繰り返す
Do Until Cells(lngCnt, 4) = vbNullString

''挿入行数セット
intCnt = Cells(lngCnt, 4) + 1

''挿入行分繰り返す
Do Until intCnt <= 0

''次の行に進む
lngCnt = lngCnt + 1

''行の選択
Rows(lngCnt & ":" & lngCnt).Select

''行の追加
Selection.Insert Shift:=xlDown

''１行追加したので挿入行数から１引く
intCnt = intCnt - 1
Loop

''処理行数カウントアップ
lngCnt = lngCnt + 1

''1シートの最大行数を超えたか？
If lngCnt > 65536 Then
MsgBox "1シートの最大行数を超えました"
Exit Do
End If
Loop

''A1を選択
Range("A1").Select
End Sub

このマクロでは
'' 処理行のD列に文字がなくなるまで繰り返す
Do Until Cells(lngCnt, 4) = vbNullString
なので、一行抜けてしまうとマクロが止まってしまいます。
これをD行に数字が入っている所はすべて増えるように？止まらないようにしたいのです。
どうすればいいでしょう？
宜しくお願いします。

回答No.2

myRange

質問のような場合は、最終行から上へ処理した方がいいでしょう。
て、Doではなく、For Nextのサンプルをひとつ。

Ｄ５～Ｄ列最終行までを対象にし、
未入力のセルは処理をジャンプする
また、Ｄ列の入力値と同じ行数を挿入する
（例えば、セルの値が、"３"だったら、３行挿入）

'-----------------------------------------
Sub test()
　Dim R As Long
　Dim StartRow As Long
　Dim LastRow As Long

　StartRow = 5
　LastRow = Cells(Rows.Count, "D").End(xlUp).Row

　For R = LastRow To StartRow Step -1
　　If Cells(R, "D").Value > 0 Then
　　　　With Cells(R, "D").Offset(1).Resize(Cells(R, "D").Value, 1)
　　　　　　.EntireRow.Insert xlDown
　　　　End With
　　End If
　Next R

End Sub
'-------------------------------------------------

なお、シート最終行（65536）のチェックはしてないので
必要なら自分で考えてみること。
以上です。

お礼

ありがとうございました。
testしたらできました。
マクロをもう少し勉強してみます。

回答No.1

ASIMOV

空白セルの場合の処理方法が判らないので、具体的なコードは書けませんが

Range("D65536").End(xlUp).Row
で、D列で、データーが入っている最後の行が判りますので、これで得られた行まで、処理を続ける様にすれば良いのでは？

また、今回の様に、処理によって行数が増えたり減ったりする場合は、後ろ（下）から処理していくと、コードが簡単になりますよ

お礼

ありがとうございました。