• 締切済み

エクセル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

みんなの回答

  • imogasi
  • ベストアンサー率27% (4737/17069)
回答No.5

エクセルのフィルター機能を使って、ある列に注目して、空白であるセルを捉え、その行を行削除したいということか。 標題や質問文には、フィルターを使ってなど書いてないし、With Range("E13", Cells(Rows.Count, 5).End(xlUp))  を書いている理由も書いてないくてわかりにくい。 VBAコードを読者が読み解け、という態度はよくないと常々思う。 質問者側で、やって見る気があるなら、下記の方法で、やってみて、早くなるかどうかみたら。 例データ A1:F10 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 ーー 処理内容は、E列で空白セルの行を削除する。 標準モジュールに 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.)のWEB記事が見つかって、組み合わせて使ってみた。 ーー 結果 ZZ1 ZZ2 ZZ3 ZZ4 ZZ5 ZZ6 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

kuulei1024
質問者

お礼

あいがとうございます。 試しましたが Range("A1").AutoFilter Field:=5, Criteria1:="=" ここの部分がRangeクラスのAutoFilterが失敗しましたと出てしまいました。

  • HohoPapa
  • ベストアンサー率65% (455/693)
回答No.4

提示のコードの場合、 対象行範囲の最終行、そのE列が空欄の時に この行が削除されずに残ってしまいませんでしょうか? 遅い理由はわかりませんが、 (力技ですが) 複数行を指定してまとめて削除するコードにしてみました。 よかったら試してみてください。 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

kuulei1024
質問者

お礼

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

  • kkkkkm
  • ベストアンサー率66% (1719/2589)
回答No.3

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

  • kkkkkm
  • ベストアンサー率66% (1719/2589)
回答No.2

> ありがとうございます。変わりはありませんでした・・ そうですか、自信はありませんがフィルタを使わずに単純に下から削除していったらどうでしょうか。 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

  • kkkkkm
  • ベストアンサー率66% (1719/2589)
回答No.1

最初に自動再計算をオフにして Application.Calculation = xlCalculationManual 最後にオンにしてみてはいかがですか。 pplication.Calculation = xlCalculationAutomatic あと最初に Application.ScreenUpdating = False 最後に Application.ScreenUpdating = True なども試してみてもいいかもしれません。

kuulei1024
質問者

お礼

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

関連するQ&A

専門家に質問してみよう