Question

有很多方法可以根据特定列中的空白单元格删除整行。我想知道的是哪种是在Excel速度方面完成此任务的最快方法。我有一张包含大约39,000个原始数据行的表单，然后在运行下面的代码后变为21,000行。问题是代码块需要将近60秒才能返回。虽然我知道CPU等等是一个因素，但让我们假设其他条件相同。

我使用A列作为总行数，将F列作为空白单元格的位置。这是编写此代码的最佳/最快方式吗？

＆＃39;查找带有文件编号的最后一行并删除剩余的行

Dim LastRow As Integer
LastRow = Range("A" & Rows.Count).End(xlUp).Row
Range("F2:F" & LastRow).SpecialCells(xlCellTypeBlanks).EntireRow.Delete

Answer 1

试试这个（希望它会有所帮助，尽管之前要备份你的表格！）：

Sub FastestBlankRowTerminator()
ActiveSheet.UsedRange.Columns(6).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

Answer 2

我设置了一个50,000行×12列的矩阵。在F栏中，我随机放置了大约25,000个空白。

将使用的范围读入数组
遍历数组并将包含F列内容的行读入结果数组
清除原始数据
编写结果数组

许多步骤，但执行时间不到一秒; screenupdating false可能会更快;如果您有更多列，则更长。

编辑： Screenupdating false并没有显着降低执行速度，使用高分辨率计时器计时约为0.36秒。

EDIT2：在阅读Tim Williams关于保留格式和公式的评论之后，我提出了一种不同的方法。这种方法将使用高级过滤器，并且在与上面相同的组成数据上，将数据放在另一个工作表上，减去列F中有空白的行。这确实需要数据中的第一行列标题;或者，至少F1有一个独特的非空白值。

完成该过程大约需要0.15秒。如果您还想将其复制回原始工作表，并删除添加的工作表，则需要大约0.3秒。

以下是一些代码，但您必须根据自己的规格进行更改：

============================================== < / p>

Sub DeleteBlankFRows2()
    Dim WS As Worksheet, wsTemp As Worksheet, rTemp As Range
    Dim R As Range, rCrit As Range
    Dim I As Long
Set WS = Worksheets("Sheet5")
Set R = WS.Range("a1").CurrentRegion
Set rCrit = R.Offset(0, R.Columns.Count + 3).Resize(2, 1)
    rCrit(1) = R(1, 6)
    rCrit(2) = "<>"

Application.ScreenUpdating = False
Worksheets.Add
    Set wsTemp = ActiveSheet
    wsTemp.Name = "Temp"
    R.AdvancedFilter xlFilterCopy, rCrit, Cells(1, 1)
    Set rTemp = wsTemp.Cells(1, 1).CurrentRegion
WS.Cells.Clear
rTemp.Copy WS.Cells(1, 1)

Application.DisplayAlerts = False
wsTemp.Delete
Application.DisplayAlerts = True

Application.ScreenUpdating = True

End Sub

=======================================

这是我使用VBA数组的原始代码：

===========================

Sub foo()
    Dim vSrc As Variant, vRes() As Variant
    Dim rSrc As Range
    Dim I As Long, J As Long, K As Long
    Dim lRows As Long

'Or may need to use a different method to include everything
Set rSrc = Range("a1").CurrentRegion
vSrc = rSrc

'how many rows to retain
For I = 1 To UBound(vSrc)
    If vSrc(I, 6) <> "" Then lRows = lRows + 1
Next I

ReDim vRes(1 To lRows, 1 To UBound(vSrc, 2))
K = 0
For I = 1 To UBound(vSrc)
    If vSrc(I, 6) <> "" Then
        K = K + 1
        For J = 1 To UBound(vSrc, 2)
            vRes(K, J) = vSrc(I, J)
        Next J
    End If
Next I

Cells.Clear
Range("a1").Resize(UBound(vRes, 1), UBound(vRes, 2)) = vRes

End Sub

Answer 3

我可以建议的最简单的事情之一应该是显着提高性能，这是在运行此程序时关闭屏幕更新和自动计算。

我通常会在最初调用代码时关闭这些项目，并在最后一次之后重新打开它们。意思是我将有一个子包含一系列其他子和函数，它将按顺序执行。我没有将它们单独嵌入到子组和函数中，而是将它们设置为关闭，执行主子组，然后重置它们。

' Speed Up
application.screenupdating = false
application.calculation = xlCalculationManual

<insert code you want to improve performance on here>    

' Slow Down
application.screenupdating = true
application.calculation = xlCalculationAutomatic

我自己运行了一个测试，自己填充了一个行数达到39000的列a，然后每个其他记录在列f中都有一个“1”。

我的core2duo仍需要一些时间，但只需46秒，如果我不关闭屏幕更新，则需要3分34秒。

Sub Main()
    ' Speed Up
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Begin ' Main Sub

    ' Reset
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

Sub Begin()
    ' Sub 1
    ' Sub 2
    ' Sub 3
    Remove_Blanks
End Sub

Sub Remove_Blanks()
    Dim dA As Date, dB As Date
    Dim wb As Workbook
    Dim ws As Worksheet

    Dim i As Long, j As Integer
    Dim r As Long, c As Integer

    dA = Now

    ' Commented out to indicate they could be here but if you are executing multiple procedures then you should have it occur outside of this.
    'Application.ScreenUpdating = False  
    'Application.Calculation = xlCalculationManual

    Set wb = ThisWorkbook
    Set ws = wb.Sheets("Sheet1")

    With ws
        For r = 1 To .UsedRange.Rows.Count
            If .Cells(r, 6) = "" Then .Rows(r).Delete
        Next r
    End With
    dB = Now

    'Commented out for same reason above
    'Application.ScreenUpdating = True
    'Application.Calculation = xlCalculationAutomatic

    Debug.Print "Remove_Blanks: " & Format((dB - dA), "mm/dd/yyyy hh:mm:ss")
End Sub

基于Blank Cell删除整行的最快方法

3 个答案: