エクセル2010 VBA 行削除

質問

特定列が空白であれば行削除をしたいのですが、下記コードでうまく削除は出来るのですが、応答なしになったり、とても遅いのですが、もう少し早く処理出来る方法はありますか？
E列が空白であれば行削除をしたいのですが・・

With Range("E13", Cells(Rows.Count, 5).End(xlUp))
.AutoFilter Field:=1, Criteria1:=""
On Error Resume Next
Set rng = .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
If Err.Number = 0 Then rng.EntireRow.Delete
On Error GoTo 0
.AutoFilter
End With

回答No.5

imogasi

エクセルのフィルター機能を使って、ある列に注目して、空白であるセルを捉え、その行を行削除したいということか。
標題や質問文には、フィルターを使ってなど書いてないし、With Range("E13", Cells(Rows.Count, 5).End(xlUp))　　を書いている理由も書いてないくてわかりにくい。
VBAコードを読者が読み解け、という態度はよくないと常々思う。
質問者側で、やって見る気があるなら、下記の方法で、やってみて、早くなるかどうかみたら。
例データ
A1:F１０
AA BB CC DD EE FF　<--見出しのつもり
a1 B1 cc1 dd1 ee1 ff1
a2 B2 cc2 dd2 ff2 <--E列セルが空白の例の行
a3 B3 cc3 dd3 ee3 ff3
a4 B4 cc4 dd4 ff4
a5 B5 cc5 dd5 ee5 ff5
a6 B6 cc6 dd6 ff6
a7 B7 cc7 dd7 ee7 ff7
a8 B8 cc8 dd8 ee8 ff8
a9 B9 cc9 dd9 ff9
ーー
処理内容は、Ｅ列で空白セルの行を削除する。
標準モジュールに
Sub test01()
Range("A1").AutoFilter Field:=5, Criteria1:="="
With Range("A1").CurrentRegion.Offset(1, 0)
.Resize(.Rows.Count - 1).EntireRow.Delete
End With
End Sub
ーー
CurrentRegionの威力かな。
自動計算は抑止して実行するほうが良いだろう。
ScreenUpdatingの抑止は心配だが。
大村あつしさん（Criteria1:="="）や田中亨さん（CurrentRegion.）のＷＥＢ記事が見つかって、組み合わせて使ってみた。
ーー
結果
ZZ１ ZZ２ ZZ３ ZZ４ ZZ５ ZZ６
a1 B1 cc1 dd1 ee1 ff1
a3 B3 cc3 dd3 ee3 ff3
a5 B5 cc5 dd5 ee5 ff5
a7 B7 cc7 dd7 ee7 ff7
a8 B8 cc8 dd8 ee8 ff8

お礼

あいがとうございます。
試しましたが
Range("A1").AutoFilter Field:=5, Criteria1:="="

ここの部分がRangeクラスのAutoFilterが失敗しましたと出てしまいました。

回答No.4

HohoPapa

提示のコードの場合、
対象行範囲の最終行、そのＥ列が空欄の時に
この行が削除されずに残ってしまいませんでしょうか？

遅い理由はわかりませんが、
（力技ですが）
複数行を指定してまとめて削除するコードにしてみました。
よかったら試してみてください。

Sub sample()

　Dim LastRow As Long
　Dim RowCounter As Long
　Dim DelNums As String

　LastRow = Range("E16").CurrentRegion.Rows.Count + _
　　 Range("E16").CurrentRegion.Row - 1
　'MsgBox LastRow
　DelNums = ""
　For RowCounter = 16 To LastRow
　　If Cells(RowCounter, 5).Value = "" Then
　　　DelNums = DelNums & Format(RowCounter) & ":" & _
　　　　Format(RowCounter) & ","
　　End If
　Next RowCounter
　If DelNums = "" Then Exit Sub
　DelNums = Left(DelNums, Len(DelNums) - 1)

　'MsgBox DelNums
　Range(DelNums).Delete

End Sub

お礼

ありがとうございます。
試しましたが実行時エラー1004
アプリケーション定義またはオブジェクト定義のエラーですと出てしまいました。

回答No.3

kkkkkm

あと
セル書き替えたときなど何かのイベントとかのマクロがありその場では必要がないのでしたら
最初に
Application.EnableEvents = False
最後に
Application.EnableEvents = True
などもありかもしれません

回答No.2

kkkkkm

> ありがとうございます。変わりはありませんでした・・

そうですか、自信はありませんがフィルタを使わずに単純に下から削除していったらどうでしょうか。

Sub Test()
Dim i As Long, LastRow As Long

LastRow = Cells(Rows.Count, 5).End(xlUp).Row
For i = LastRow To 13 Step -1
If Cells(i, "E").Value = "" Then
Rows(i).Delete
End If
Next
End Sub

回答No.1

kkkkkm

最初に自動再計算をオフにして
Application.Calculation = xlCalculationManual
最後にオンにしてみてはいかがですか。
pplication.Calculation = xlCalculationAutomatic

あと最初に
Application.ScreenUpdating = False
最後に
Application.ScreenUpdating = True

なども試してみてもいいかもしれません。

お礼

ありがとうございます。変わりはありませんでした・・