VBA ループについて質問です。

質問

お世話になります。

VBA
ループで『2行目を削除して空白になったら終了』がうまくいきません。

※1行目は固定です。
※2行目を削除したら、3行目以下が上がって3行目が2行目になります。
※2行目に何もなくなったらループ終了
※実際は複数シートで他の作業もあるので、『i』でなく『j』です。
※複数シートでの作業が出来る記述でおねがいします。

▼▼▼▼▼▼
Dim j As Long
j = 2

Do While Cells(j, 1) <> ""

Sheets("◆抽出先 (提灯)").Select

Rows("2:2").Select
Selection.Delete Shift:=xlUp

j = j + 1

Loop
▲▲▲▲▲▲

どうすれば良いでしょうか？

すみませんがよろしくお願いいたします。

Windows10
EXCEL 2010

回答No.6

watabe007 · ベストアンサー

行の削除は下から行うと楽ですよ
Sub Test()
　　Dim j As Long, LastRow As Long

　　Sheets("◆抽出先 (提灯)").Select
　　LastRow = Cells(Rows.Count, "A").End(xlUp).Row
　　For j = LastRow To 2 Step -1
　　　　If Cells(j, 1).Value = "" Then Rows(j).Delete Shift:=xlUp
　　Next
End Sub
>※複数シートでの作業が出来る記述でおねがいします。
Sub Test2()
　　Dim j As Long, LastRow As Long
　　Dim sh As Variant

　　For Each sh In Sheets(Array("◆抽出先 (提灯)", "Sheet1", "Sheet2"))
　　　　LastRow = sh.Cells(Rows.Count, "A").End(xlUp).Row
　　　　For j = LastRow To 2 Step -1
　　　　　　If sh.Cells(j, 1).Value = "" Then sh.Rows(j).Delete Shift:=xlUp
　　　　Next
　　Next
End Sub

お礼

違う方法で解決したのですが、下からの削除は
考えもしなかったです。

次回に使えそうです。

ありがとうございます。

他の回答していただいた方もありがとうございました！！

回答No.5

bunjii

▼▼▼▼▼▼
Dim j As Long ' 不要
j = 2 ' 不要
Do While Cells(j, 1) <> "" ' Do While Cells(2,1) <> "" に変更
Sheets("◆抽出先 (提灯)").Select
Rows("2:2").Select
Selection.Delete Shift:=xlUp
j = j + 1 ' 不要
Loop
▲▲▲▲▲▲
提示のコードでは半数が削除漏れになります。
原因は空欄をチェックしているセルがA2、A3、A4、・・・・と下方に移動し、実際に削除される行とかけ離れるためです。

回答No.4

imogasi

>※2行目に何もなくなったらループ終了
意味がよくわかりません。
２行目（固定して、そのシートで１回作業）なら、行を固定して行削除してそのシートの作業は終了し、次のシートに移っていけばよいのでは？
その場合簡単なコードは
Sub test01()
For Each sh In Worksheets
sh.Rows(2).EntireRow.Delete
Next
End Sub
行を上に詰めている。
詰めないならＤｅｌｅｔｅでなくデータを空白セルにするコードにする。
Range("A２").EntireRow.Clear　のような。
Sub test02()
For Each sh In Worksheets
sh.Range("A２").EntireRow.Clear
Next
End Sub
ーー
＞※2行目に何もなくなったらループ終了
は次のシートの第２行に移るということか？
はっきり書くこと。
ー
一般に、繰り返し作業で行を変数で指定して削除する場合は、データ最下行から
削除作業を繰り返すのが鉄則かと。
J＝ｊ＋１で次次の行までなぜ繰り返すのか

回答No.3

kkkkkm

j = j + 1
の後ろに
Debug.Print j
として実行後にイミディエイトウィンドウを見るとjの値が出てるのでそれで原因がわかると思います。

シートのSelectはループの前でいいと思いますよ。
Dim j As Long
Sheets("◆抽出先 (提灯)").Select
Do While Cells(2, 1) <> ""
Rows("2:2").Delete Shift:=xlUp
Loop

あと一括で削除したほうが早い場合があります。

Sub Example()
Dim j As Long
j = 2
Sheets("◆抽出先 (提灯)").Select
Do While Cells(j, 1) <> ""
j = j + 1
Loop
If j > 2 Then
Rows("2:" & j - 1).Delete Shift:=xlUp
End If
End Sub

A列のデータが入っている最終行まで削除するのでしたら(途中で空白があっても最終データの行まで)

Sub Example2()
Sheets("◆抽出先 (提灯)").Select
If Cells(Rows.Count, "A").End(xlUp).Row <> 1 Then
Rows("2:" & Cells(Rows.Count, "A").End(xlUp).Row).Delete Shift:=xlUp
End If
End Sub

回答No.2

AsarKingChang

j = 2
消すのが固定の「２行目」なので、実質これは固定値ですよ。
j = j + 1
これの実行後「３行目、４行目」とどんどん、次の行を選択してますから。
なので、固定したいものを動かしたことが、問題だったのかも

回答No.1

HohoPapa

j = j + 1
↑の行が余分と思います。