Question

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

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

Answer 1

尝试避免使用整个列以及jq：

.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

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是最后一个带有值的行

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

3 个答案: