1

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

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

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 多行的电子表格，它可能会很慢。有没有更有效的方法来做到这一点？

提前感谢您的任何建议。

干杯

诺埃尔

4

3 回答 3

3

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

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
于 2012-11-05T17:04:33.520 回答
2

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

请注意，每次删除时都不必要地重新测试行，因为删除会使行向上滑动。r因此，您可以在每次删除时递减以进行小优化。

进一步的优化是一次读取所有测试值。每次从/向 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
于 2012-11-05T14:48:28.940 回答
0

如果预期的错误很少，则应该更快地找到匹配的单元格并将其删除。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
于 2012-11-05T14:58:09.457 回答