有很多方法可以根据特定列中的空白单元格删除整行。我想知道的是哪种是在Excel速度方面完成此任务的最快方法。我有一张包含大约39,000个原始数据行的表单,然后在运行下面的代码后变为21,000行。问题是代码块需要将近60秒才能返回。虽然我知道CPU等等是一个因素,但让我们假设其他条件相同。
我使用A列作为总行数,将F列作为空白单元格的位置。这是编写此代码的最佳/最快方式吗?
'查找带有文件编号的最后一行并删除剩余的行
Dim LastRow As Integer
LastRow = Range("A" & Rows.Count).End(xlUp).Row
Range("F2:F" & LastRow).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
答案 0 :(得分:0)
试试这个(希望它会有所帮助,尽管之前要备份你的表格!):
Sub FastestBlankRowTerminator()
ActiveSheet.UsedRange.Columns(6).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub
答案 1 :(得分:0)
我设置了一个50,000行×12列的矩阵。在F栏中,我随机放置了大约25,000个空白。
许多步骤,但执行时间不到一秒; 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
答案 2 :(得分:0)
我可以建议的最简单的事情之一应该是显着提高性能,这是在运行此程序时关闭屏幕更新和自动计算。
我通常会在最初调用代码时关闭这些项目,并在最后一次之后重新打开它们。意思是我将有一个子包含一系列其他子和函数,它将按顺序执行。我没有将它们单独嵌入到子组和函数中,而是将它们设置为关闭,执行主子组,然后重置它们。
' 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