刪除空行

Question

我有一個Excel宏，用於刪除Excel工作表中的所有空行。這個宏需要很長時間才能完成。這些文件是自動生成的，每個文件都需要運行這個宏。在檢查其值後，宏一次刪除一行。

我需要的是這樣的：

If rowValue = "" then 
    deleteThisRow And deleteAll Subsequent rows at once 
End If 

這是我現在使用的代碼：

Sub RemoveRows() 
    Range("A8").Select 
    Dim checkval 
    Dim RowAmount 
    RowAmount = 93 

    Do 
     checkval = ActiveCell.Value 
     If (checkval = "") Then 
      ActiveCell.EntireRow.Delete 
     Else 
      ActiveCell.Offset(1, 0).Select 
     End If 
     RowAmount = RowAmount - 1 
    Loop While RowAmount > 0 
End Sub 

Answer 1

所以基本上，如果它遇到一個空白行，應刪除該行並它下面的所有行。

要刪除下面的所有行，你可以做同樣的事情，當你按下CTRL和向下的箭頭 - 它會去下一個值（如果有的話），在你的情況下，它聽起來像將不會）或到最後（第65536行是我遇到的所有Excel版本中的限制）。這將是...

Range(Selection, Selection.End(xlDown)).Select 
Selection.Delete Shift:=xlUp 

這會從您所選擇的行（因此沒有必要將其刪除），下降到無論是下一個值或結束，並刪除所有這些行。

編輯 - 整個宏：

Dim i As Integer 
For i = 1 To 93 
    Range("A" & i).Select 
    Dim CheckVal As String 
    CheckVal = ActiveCell.Value 
    If (CheckVal = "") Then 
     Range(Selection, Selection.End(xlDown)).Select 
     Selection.Delete Shift:=xlUp 
    End If 
Next i 

請記住，雖然，如果有低於找到的第一個「空白」的任何值，它們都被刪除了作爲第一個連續的值。

Answer 2

您的想法是在一次操作中刪除所有必要的行是轟動的。此外，避免Select並避免循環一定範圍的單元格也會加快速度。

這裏是一個應該爲你工作

Sub Demo() 
    Dim sh As Worksheet 
    Dim rng As Range 
    Dim rngBlanks As Range 

    ' Get a reference to the sheet you want to process 
    Set sh = ActiveSheet 

    ' Get a reference to the range of cells to test 
    With sh 
     Set rng = .Range(.Cells(8, 1), .Cells(.Rows.Count, 1).End(xlUp)) 
    End With 

    ' if there are no blanks SpecialCells will error, so handle it 
    On Error Resume Next 
    ' Reduce rng to reference only blank cells 
    Set rngBlanks = rng.SpecialCells(xlCellTypeBlanks) 
    On Error GoTo 0 

    ' see if there are any blanks 
    If Not rngBlanks Is Nothing Then 
     ' delete all of them 
     rngBlanks.EntireRow.Delete 
    End If 
End Sub 

---

更新基礎上提供額外信息的方法：「空白」細胞可能包含公式返回一個空字符串。

下面是使用AutoFilter

Sub Demo() 
    Dim sh As Worksheet 
    Dim rng As Range 
    Dim rngBlanks As Range 

    Application.ScreenUpdating = False 
    ' Get a reference to the sheet you want to process 
    Set sh = ActiveSheet 

    ' Get a reference to the range of cells to test, plus header row 
    With sh 
     Set rng = .Range(.Cells(7, 1), .Cells(.Rows.Count, 1).End(xlUp)) 
    End With 

    ' Apply filr to hide non-empty cells 
    sh.AutoFilterMode = False 
    rng.AutoFilter Field:=1, Criteria1:="=", VisibleDropDown:=True 

    ' if there are no blanks SpecialCells will error, so handle it 
    On Error Resume Next 
    ' Reduce rng to reference only blank cells, exclude header row 
    Set rngBlanks = rng.Offset(1, 0).SpecialCells(xlCellTypeVisible) 
    On Error GoTo 0 

    ' see if there are any blanks 
    If Not rngBlanks Is Nothing Then 
     ' delete all of them 
     rngBlanks.EntireRow.Delete 
    End If 

    sh.AutoFilterMode = False 
    Application.ScreenUpdating = True 
End Sub