空白行を削除して上へ詰めたい

質問

例えば、画像のように
1行目から１０行目の間に適当に値が入ってるとします。
その中で、行に何も入っていないのなら、削除して上へ詰めたいのですが
どのようなコードを書けばいいでしょうか？

該当の行の1列目から256列目のどの列にも値が入ってないのが条件です。

自分なりに考えたのですが
----------------------------------------
Sub test1()
Dim i, gyou As Long

For gyou = 1 To 10 '最終行
i = WorksheetFunction.CountA(Rows(gyou))
If i = 0 Then
Rows(gyou).Delete
gyou = gyou - 1 '削除すると行がずれる
End If
Next

End Sub
----------------------------------------
Sub test2()
Dim i, gyou As Long
gyou = 1

Do While gyou <> 10
i = WorksheetFunction.CountA(Rows(gyou))

If i = 0 Then
Rows(gyou).Delete
Else
gyou = gyou + 1
End If

Loop

End Sub
----------------------------------------
どちらも、なぜか無限ループになってしまいます。
どうすればいいか教えてください。

回答No.1

tom04 · ベストアンサー

こんばんは！

Sub test3()
Dim i As Long
For i = 10 To 1 Step -1
If WorksheetFunction.CountA(Rows(i)) = 0 Then
Rows(i).Delete
End If
Next i
End Sub

こんな感じではどうでしょうか？

※　一般的に挿入・削除の場合は最終行（最終列）からLoopさせた方が良いと思います。m(_ _)m

お礼

下から上に行った方が簡単だしわかりやすいですね。
うまく出来ました。ありがとうございました。

回答No.3

toshi_2010

Sub test1()
Dim i, gyou As Long

For gyou = 1 To 10 '最終行
i = WorksheetFunction.CountA(Rows(gyou))
If i = 0 Then
Rows(gyou).Delete
gyou = gyou - 1 '削除すると行がずれる
End If
Next

End Sub

gyou = gyou - 1・・・これが原因です。
絶対に１０になりません。Forループ抜けられなくなります。

以下で出来ます。

Sub test1()
Dim i, gyou As Long

For gyou = 1 To 10 '最終行
i = WorksheetFunction.CountA(Rows(gyou))
If i = 0 Then
Rows(gyou).Delete

End If
Next

End Sub

お礼

ご回答ありがとうございます。

Sub test1()
Dim i, gyou As Long

For gyou = 1 To 10 '最終行
i = WorksheetFunction.CountA(Rows(gyou))
If i = 0 Then
Rows(gyou).Delete

End If
Next

End Sub

だと、
例えば８行目と９行目が連続して空白の場合、9行目は削除されなくなってしまわないでしょうか？

回答No.2

unacyo

test1()は、削除対象行が見つかった場合、削除後gyou-1をしていますが、forによって+1されます。
これが、10行以内に何もない行を見つけてしまうと、gyou-1、forで＋１、となりおなじ行のチェックを無限に行います。

test2()は、削除対象行が見つかった場合、削除のみ行ってgyouを更新しません。
10行以内にこれが見つかると、削除のみ行うことになり、さらにすべて削除してしまった場合、以降何もデータが入っていませんから、
ずっと削除(i=0)が動き、gyouが更新されず、gyou<>10が永遠に満たされません。

削除することで行がずれて困る、というのであれば、別の方法として、先に調べるだけ調べてから、
まとめて削除するという手もありますよ。
Sub Macro1()
Dim strRange As String, i, gyou As Long

For gyou = 1 To 10 '最終行
i = WorksheetFunction.CountA(Rows(gyou))
If i = 0 Then
'ここで、削除対象の行を文字列に入れていく
If strRange <> "" Then strRange = strRange + "," '行を区切るのはカンマで。
strRange = strRange + CStr(gyou) + ":" + CStr(gyou) '１つの行は、"行番号：行番号"で指定
End If
Next gyou
If strRange <> "" Then
'削除対象がある(文字列が空でない)場合、まとめて選択して削除
Debug.Print strRange
Range(strRange).Select
Selection.Delete Shift:=xlUp '上方向につめる
End If
End Sub

お礼

＞test1()は、削除対象行が見つかった場合、削除後gyou-1をしていますが、forによって+1されます。
これが、10行以内に何もない行を見つけてしまうと、gyou-1、forで＋１、
となりおなじ行のチェックを無限に行います。

これが原因で無限ループに陥ってしまうのですね。

このような方法があるのですか。
全然思いつきませんでした。斬新なアイディアです。ありがとうございました。