Excel 2007の列Aの空の行を削除します。

Question

列Aから空の行を取り出し、行全体を削除する次のコードがあります。 2007年には上限が約8000の連続していない行があるため、特殊 - >ブランク - >シート行削除機能を2010年に使用することはできませんでした。このコードはいくつかの古いマシンでは非常に遅く、終了するのに約40分かかります（しかし、その仕事をします）。これにはもっと速い選択肢がありますか？

Private Sub Del_rows() 
    Dim r1 As Range, xlCalc As Long 
    Dim i As Long, j As Long, arrShts As Variant 
    With Application 
     xlCalc = .Calculation 
     .Calculation = xlCalculationManual 
     .ScreenUpdating = False 
    End With 
    arrShts = VBA.Array("Sheet1") 'add additional sheets as required 
    For i = 0 To UBound(arrShts) 
     With Sheets(arrShts(i)) 
      For j = .UsedRange.Rows.Count To 2 Step -8000 
       If j - 7999 < 2 Then 
        .Range("A2:A" & j).SpecialCells(xlCellTypeBlanks).EntireRow.Delete 
       Else 
        .Range("A" & j, "A" & j - 7999).SpecialCells(xlCellTypeBlanks).EntireRow.Delete 
       End If 
      Next j 
     End With 
    Next i 
    Application.Calculation = xlCalc 

Answer 1

このコードは100,000行（レコードより完全なコードのためのアクションを必要に応じて）上の第2の下取ります

Sub DeleteRows() 

Application.ScreenUpdating = False 
Columns(1).Insert xlToRight 
Columns(1).FillLeft 
Columns(1).Replace "*", 1 
Cells.Sort Cells(1, 1) 
Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete 
Columns(1).Delete 

End Sub 

Answer 2

Rajiv、これを試してください。これは速くなければなりません。

Option Explicit 

Sub Sample() 
    Dim delrange As Range 
    Dim LastRow As Long, i As Long 

    With Sheets("Sheet1") '<~~ Change this to the relevant sheetname 
     '~~> Get the last Row in Col A 
     LastRow = .Range("A" & .Rows.Count).End(xlUp).Row 

     For i = 1 To LastRow 
      If Len(Trim(.Range("A" & i).Value)) = 0 Then 
       If delrange Is Nothing Then 
        Set delrange = .Rows(i) 
       Else 
        Set delrange = Union(delrange, .Rows(i)) 
       End If 
      End If 
     Next i 

     If Not delrange Is Nothing Then delrange.Delete 
    End With 
End Sub 

EDIT：

また、行を削除するためにオートフィルタを使用することができます。これはかなり速いです。私はは、このような巨大な行の両方の例をテストしていない:)あなたが何かエラーが発生した場合は教えてください。

Option Explicit 

Sub Sample() 
    Dim lastrow As Long 
    Dim Rng As Range 

    With Sheets("Sheet1") 
     lastrow = .Range("A" & .Rows.Count).End(xlUp).Row 

     '~~> Remove any filters 
     .AutoFilterMode = False 

     With .Range("A1:A" & lastrow) 
      .AutoFilter Field:=1, Criteria1:="" 
      .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete 
     End With 

     '~~> Remove any filters 
     ActiveSheet.AutoFilterMode = False 
    End With 
End Sub 

HTH

シド