Excel VBA：代码删除行IF空白单元格;优化

Question

基本上，当在一个工作簿（1张）中运行以下代码时，它会立即完成。但是当在我的主工作簿中使用它（几张纸，几乎没有任何数据）时，需要一段时间才能完成。如何优化以下代码？

Sub DeleteBlankRows()
    On Error Resume Next
    Sheets("Sheet4").Activate
    Columns("D").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

Answer 1

尽量避免使用整个列，以及.Activate：

Sub DeleteBlankRows()
   ' On Error Resume Next
    Dim lastRow As Long
    With Sheets("Sheet4")
        lastRow = .Cells(Rows.Count, 4).End(xlUp).row
        .Range(.Cells(1, 4), .Cells(lastRow, 4)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    End With
End Sub

编辑：注释掉On Error Resume Next

Answer 2

你也可以尝试停止自动计算和屏幕更新，最后重新启用所有。

尝试这个并测试其他代码

Sub DeleteBlankRows()
   Application.ScreenUpdating = False
   Application.Calculation = xlManual

   On Error Resume Next
   Sheets("Sheet4").Activate
   Columns("D").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

   Application.ScreenUpdating = true
   Application.Calculation = xlAutomatic
End Sub

祝好运

Answer 3

   lastRow = .Cells(Rows.Count, 4).End(xlUp).row

我从来没有用这种方法搞清楚最后一行。这需要太长时间......基本上从工作表底部开始处理每个单元格。相反，我用值来计算单元格的数量。我使用该数字来运行for循环，该循环测试以查看给定单元格中是否存在值并计数直到考虑具有值的所有单元格。代码方面，它更复杂......但根据我的经验执行得更快。

kount = Application.WorksheetFunction.CountA(krng) 'Count how many used cells there are

kRow = 1
j = 1

Do Until j = kount + 1 'Do until all used cells are acounted for

If Cells(kRow, l).Value = vbNullString Then 'If current cell is empty skip it
    Else
    j = j + 1 'If the current cell has a value count up
    End If
    kRow = kRow + 1 'but go on to the next row either way
Loop

其中kRow是具有值的最后一行