Удалить пустые строки в столбце A в Excel 2007

Question

У меня есть следующий фрагмент кода, который берет пустые строки из столбца A, а затем удаляет всю строку. Я не мог использовать функцию Special -> Blanks -> Delete Sheet Rows в 2010 году, потому что 2007 имеет верхнюю границу приблизительно 8000 несмежных строк. Этот код очень медленный на некоторых старых машинах и занимает около 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

Раджив, попробуй это.Это должно быть быстро.

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

РЕДАКТИРОВАТЬ :

Вы также можете использовать автофильтр для удаления строк.Это довольно быстро.Я не проверил оба примера для таких огромных строк :) Дайте мне знать, если у вас появятся какие-либо ошибки.

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

Sid

Answer 2

Этот код занимает менее 100 000 строк (запишите действия для более полного кода, если необходимо):

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