在电子表格中删除行的有效方法

是否有更好的方法删除Excel电子表格中的行比我目前使用？

在电子表格中，如果特定单元格中的数字为“0”，则运行一个删除行的macros。

Public Sub deleteRowsIfZero(colDelete As Integer) Dim r As Long Application.ScreenUpdating = False For r = Cells(Rows.Count, colDelete).End(xlUp).Row To 1 Step -1 If Cells(r, colDelete).Value = "0" Then Rows(r).Delete Next r Application.ScreenUpdating = True End Sub 

这是有效的，但是有700多行的电子表格可能会很慢。 有没有更有效的方法来做到这一点？

预先感谢您的任何build议。

干杯

诺埃尔

Answer 1

在开始之前closures屏幕更新和计算，并在最后恢复这些设置。

请注意，每次删除时都会不必要地重新testing一行，因为删除会将行向上滑动。 因此，您可以在每次删除小型优化时减lessr 。

进一步的优化是一次读入所有的testing值。 从/到/ Excel / VBA的每个读/写都有开销。 看下面的例子：

 Dim r As Long, n As Long Dim testcells As Variant n = Cells(Rows.count, rowdelete).End(xlUp).Row testcells = Range(Cells(n, rowdelete), Cells(1, rowdelete)).Value For r = n To 1 Step -1 If testcells(r, 1) = 0 Then Rows(r).Delete End If Next r 

您也可以尝试一次删除所有内容，以查看哪个更快。

 Dim r As Long, n As Long Dim testcells As Variant Dim del As Range n = Cells(Rows.Count, rowdelete).End(xlUp).Row testcells = Range(Cells(n, rowdelete), Cells(1, rowdelete)).Value For r = n To 1 Step -1 If testcells(r, 1) = 0 Then If del Is Nothing Then Set del = Rows(r) Set del = Union(del, Rows(r)) End If Next r If Not (del Is Nothing) Then del.Delete End If 

Answer 2

我会使用一个连续的范围并一次删除它：

 Public Sub deleteRowsIfZero(strSeekValue As String) Dim lngRowsToDelete() As Long Dim strRowsToDelete() As String Dim x As Long, y As Long, n As Long, z As Long On Error GoTo err_ 'get the extent of the workbook range x = Me.UsedRange.Rows.Count n = -1 'switch off screen updating and calculation Application.ScreenUpdating = False Application.Calculation = xlCalculationManual 'starting from row 1, look for the strSeekValue in column A, keep going till x is reached For y = 1 To x If Me.Range("A" & y).Value = strSeekValue Then 'if we find one, pop the row number into the array n = n + 1 ReDim Preserve lngRowsToDelete(0 To n) lngRowsToDelete(n) = y End If Next y 'if none were found, don't do the next bit If n = -1 Then GoTo err_ 'create a string of all the rows we found z = 0 ReDim strRowsToDelete(z) For y = 0 To n strRowsToDelete(z) = strRowsToDelete(z) & lngRowsToDelete(y) & ":" & lngRowsToDelete(y) & "," If Len(strRowsToDelete(z)) > 240 Then 'As A.Webb points out, the 255 limit will be a problem here strRowsToDelete(z) = Left(strRowsToDelete(z), Len(strRowsToDelete(z)) - 1) 'drop the trailing comma z = UBound(strRowsToDelete) + 1 'resize the array ReDim Preserve strRowsToDelete(0 To z) End If Next y For y = z To 0 Step -1 If Right(strRowsToDelete(z), 1) = "," Then strRowsToDelete(z) = Left(strRowsToDelete(z), Len(strRowsToDelete(z)) - 1) 'now delete the rows Me.Range(strRowsToDelete(y)).EntireRow.Delete Next y err_: 'assumes calculation was set to auto Application.Calculation = xlCalculationAutomatic If Err Then Debug.Print Err.Description Application.ScreenUpdating = True End Sub 'run sub foo Sub foo() deleteRowsIfZero "0" End Sub 

Answer 3

如果预期的错误很less，find匹配的单元格并删除它们应该会更快。 D列正在保留删除的字符。

 Sub DeleteRowWithCertainValue() Dim del_char As String del_char = "0" Do On Error GoTo ErrorHandler Sheets("Sheet1").Range("D:D").Find(What:=del_char, _ After:=Range("D1"), _ LookIn:=xlValues, _ LookAt:=xlWhole, _ SearchOrder:=xlByColumns, _ SearchDirection:=xlNext, _ MatchCase:=False).EntireRow.Delete Loop ErrorHandler: Exit Sub End Sub