使用VBA删除行的最有效方式

Question

我目前有一个宏，用于删除记录，如果ID不存在于我从XML文档创建的ID列表中。它确实按照我想要的方式工作，但是电子表格中有超过1000列（每年的每一天都有一列，直到2015年底），因此删除行需要很长时间，而且只能执行1或2次，然后会显示“Excel耗尽了资源并必须停止”。以下是我用于宏的代码，是否有其他方法可以做到这一点，使Excel不会耗尽资源？

Sub deleteTasks()

Application.ScreenUpdating = False

Dim search As String
Dim sheet As Worksheet
Dim cell As Range, col As Range
Set sheet = Worksheets("misc")
Set col = sheet.Columns(4)

ActiveWorkbook.Sheets("Schedule").Activate
ActiveSheet.Range("A4").Select
ActiveSheet.Unprotect
ActiveSheet.Range("A:C").EntireColumn.Hidden = False

Do While ActiveCell.Value <> ""

    search = ActiveCell.Value

    Set cell = col.Find(What:=search, LookIn:=xlValues, _
                 LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                 MatchCase:=False, SearchFormat:=False)

    If cell Is Nothing Then 'If the taskID is not in the XML list

    Debug.Print "Deleted Task: " & ActiveCell.Value
    Selection.EntireRow.Delete

    End If

    ActiveCell.Offset(1, 0).Select 'Select next task ID

Loop

ActiveSheet.Range("A:B").EntireColumn.Hidden = True
ActiveSheet.Protect
End Sub

在尝试了包括下面列出的所有答案在内的许多不同选项后，我意识到无论使用什么方法，在我的普通笔记本电脑上（2.20 Ghz，4GB RAM）删除一个具有约1100列的行都需要一段时间。由于大多数行为空，我找到了一种更快的替代方法。我只清除包含数据的单元格（A:S），然后调整表格大小以删除刚刚删除数据的行。这个最终结果与 entireColumn.Delete 完全相同。以下是我现在正在使用的代码。

'New method - takes about 10 seconds on my laptop
Set ws = Worksheets("Schedule")
Set table = ws.ListObjects(1)
Set r = ws.Range("A280:S280")

r.Clear

table.Resize Range("A3:VZ279")

如果使用EntireColumn.Delete或手动选择行并删除，这些操作在我的笔记本电脑上大约需要20-30秒。当然，只有当您的数据在表格中时，此方法才有效。

- Harry12345

---

一个好的起点是不使用Select。 - chris neilsen

那么不要循环一个范围，将其复制到变量数组中并循环该数组。并且在循环外构建要删除的行的集合，然后一次性删除。 - chris neilsen

谢谢你的建议，我会尝试一下并看看效果如何。 - Harry12345

@Harry12345，感谢您的反馈。该方法可以删除所有列，而不仅仅是一个。我只是为了测试目的填充了一个列。整个包含所有列的行都将被删除。基准测试是客观地衡量效率与任何其他方法的标准。请查看下面答案中的我的评论。因此，要有效地删除单行，请使用ActiveSheet.Range(DelStr).Delete，其中DelStr="15:15"，如果您想删除包括所有列等的第15行。 - hnk

Answer 1

简短回答：

使用类似于以下的东西：

ActiveSheet.Range(DelStr).Delete
' where DelStr = "15:15" if you want to delete row 15
'              = "15:15,20:20,32:32" if you want to delete rows 15,20 and 32

长答案： 重要提示：如果您需要删除约30/35行，则以下代码非常有效。超过这个数量会引发错误。要处理任意数量的行，请参见下面的非常长的答案。

如果您有一个函数可以列出要删除的行，请尝试使用下面的代码。这是我用来高效地删除多行数据并使开销最小化的方法。（示例假设您已经通过某些程序获取了需要删除的行，这里我手动输入它们）：

Sub DeleteRows()
    Dim DelRows() As Variant
    ReDim DelRows(1 To 3)

    DelRows(1) = 15
    DelRows(2) = 18
    DelRows(3) = 21

    '--- How to delete them all together?

    Dim i As Long
    For i = LBound(DelRows) To UBound(DelRows)
        DelRows(i) = DelRows(i) & ":" & DelRows(i)
    Next i

    Dim DelStr As String
    DelStr = Join(DelRows, ",")

    ' DelStr = "15:15,18:18,21:21"
    '           
    '    IMPORTANT: Range strings have a 255 character limit
    '    See the other code to handle very long strings

    ActiveSheet.Range(DelStr).Delete
End Sub

任意行数的高效解决方案和基准测试结果：

以下是通过删除行获得的基准测试结果（时间以秒为单位 vs. 行数）。

这些行位于一个干净的工作表上，并且在D1:D100000中包含一个易失性公式。

即对于100,000行，它们有一个公式=SIN(RAND())

代码很长，不太美观，但它将DelStr拆分成250个字符的子字符串，并使用这些形成一个范围。然后新的DeleteRng范围在单个操作中被删除。

删除所需的时间可能取决于单元格的内容。测试/基准测试与一点直觉结合，建议以下结果。

• 稀疏行/空单元格最快删除
• 具有值的单元格需要更长时间
• 具有公式的单元格需要更长时间
• 馈送到其他单元格公式的单元格需要最长时间，因为它们的删除会触发#Ref引用错误。

代码：

Sub DeleteRows()

    ' Usual optimization
    ' Events not disabled as sometimes you'll need to interrupt
    ' You can optionally keep them disabled

    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False

    ' Declarations...

    Dim DelRows() As Variant

    Dim DelStr As String, LenStr As Long
    Dim CutHere_Str As String
    Dim i As Long

    Dim MaxRowsTest As Long
    MaxRowsTest = 1000

    ' Here I'm taking all even rows from 1 to MaxRowsTest
    ' as rows to be deleted

    ReDim DelRows(1 To MaxRowsTest)

    For i = 1 To MaxRowsTest
        DelRows(i) = i * 2
    Next i

    '--- How to delete them all together?

    LenStr = 0
    DelStr = ""

    For i = LBound(DelRows) To UBound(DelRows)
        LenStr = LenStr + Len(DelRows(i)) * 2 + 2

        ' One for a comma, one for the colon and the rest for the row number
        ' The goal is to create a string like
        ' DelStr = "15:15,18:18,21:21"

        If LenStr > 200 Then
            LenStr = 0
            CutHere_Str = "!"       ' Demarcator for long strings
        Else
            CutHere_Str = ""
        End If

        DelRows(i) = DelRows(i) & ":" & DelRows(i) & CutHere_Str
    Next i

    DelStr = Join(DelRows, ",")

    Dim DelStr_Cut() As String
    DelStr_Cut = Split(DelStr, "!,")
    ' Each DelStr_Cut(#) string has a usable string

    Dim DeleteRng As Range
    Set DeleteRng = ActiveSheet.Range(DelStr_Cut(0))

    For i = LBound(DelStr_Cut) + 1 To UBound(DelStr_Cut)
        Set DeleteRng = Union(DeleteRng, ActiveSheet.Range(DelStr_Cut(i)))
    Next i

    DeleteRng.Delete

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

End Sub

在一个空白工作表中生成公式的代码是：

Sub FillRandom()
    ActiveSheet.Range("D1").FormulaR1C1 = "=SIN(RAND())"
    Range("D1").AutoFill Destination:=Range("D1:D100000"), Type:=xlFillDefault
End Sub

生成上述基准测试结果的代码如下：

Sub TestTimeForDeletion()

        Call FillRandom

        Dim Time1 As Single, Time2 As Single
        Time1 = Timer

        Call DeleteRows

        Time2 = Timer
        MsgBox (Time2 - Time1)
End Sub

注意：非常感谢brettdj指出了一个错误，即当DelStr的长度超过255个字符时会抛出错误。这似乎是一个已知问题，而且如我痛苦地发现的那样，它在Excel 2013中仍然存在。

- hnk

---

因为在我的测试中，DelStr的长度为255个字符或DelRows(1到46)，代码很快就会崩溃，所以被踩了。 - brettdj

@brettdj 很棒的观点，我在发布前应该测试更长的字符串。我的错。我已更新代码以包括任意字符串长度和删除的行数。我还包括了基准测试和基准结果，以找出不同行数所需的时间。即将上传它们。感谢您指出这一点。非常感激。一度考虑删除我的答案，但新的答案似乎也表现得相当高效。来看看吧！ - hnk

没问题 - 你编辑后我会取消踩的。 - brettdj

我认为你误解了问题。我要删除的是有1000列的1行，而不是一个单一列的1000行，你的回答做得非常好。 - Harry12345

没问题，我删除许多行的原因是为了以某种方式衡量效率。因此，这可以与任何其他方法进行客观比较。正如我们所看到的，这种方法呈线性扩展，因此要删除一行，需要在相当快的计算机上花费0.0093秒（我的规格是2.8 GHz、4核笔记本电脑，内存为16 GB）。如果这对你有用，你可以简单地使用“短答案”方法。祝一切顺利！另外，@Harry12345，这种方法将删除所有列，而不仅仅是一列。 - hnk

Answer 2

这段代码使用了AutoFilter，比逐行循环要快得多。

我每天都在使用它，应该很容易理解。

只需传入你要查找的内容和要搜索的列即可。

如果需要，您也可以硬编码列。

private sub PurgeRandy
    Call FindDelete("F", "Randy")
end sub

Public Sub FindDelete(sCOL As String, vSearch As Variant) 'Simple find and Delete
Dim lLastRow As Integer
Dim rng As Range
Dim rngDelete As Range
    Range(sCOL & 1).Select
    [2:2].Insert
    [2:2] = "***"
    Range(sCOL & ":" & sCOL).Select

    With ActiveSheet
        .UsedRange
            lLastRow = .Cells.SpecialCells(xlCellTypeLastCell).Row
        Set rng = Range(sCOL & 2, Cells(lLastRow, sCOL))
            rng.AutoFilter Field:=1, Criteria1:=vSearch
        Set rngDelete = rng.SpecialCells(xlCellTypeVisible)
            rng.AutoFilter
            rngDelete.EntireRow.Delete
        .UsedRange
    End With
End Sub

- BeachBum68

---

这里漏掉了OP正在使用循环来查找多个字符串，而OP已经在使用“Find”来定位每个搜索字符串。 - brettdj

此例程可在列中查找所有 vSearch 的实例。无需遍历列中的每个单元格以查找每个实例。 - BeachBum68

这只是一个如何使用AutoFilter的示例，我发现它比在遍历单元格范围时使用查找要快得多。各有所好。 - BeachBum68

自动筛选是一个很好的方法。我指出OP有多个值可用于行删除，所以你的程序需要被调用多次。这部分是OP代码中当前的瓶颈。 - brettdj

Answer 3

在这种情况下，可以使用一个简单的工作公式来查看要测试的范围中的每个值（日程表的A列）是否存在于杂项的F列中

在B4中，它将是=MATCH(A4,misc!D:D,0)

这可以手动使用或者使用代码进行高效删除，因为该公式会根据设计返回错误，如果没有匹配项，则可以使用VBA来高效地删除，方法如下:

• AutoFilter
• SpecialCells (即design部分*)

在xl2007中，请注意具有8192个不同区域的限制SpecialCells的选择范围。

代码

Sub ReCut()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim rng1 As Range

Set ws1 = Sheets("misc")
Set ws2 = Sheets("schedule")

With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
End With

Set rng1 = ws2.Range(ws2.[a4], ws2.Cells(Rows.Count, "A").End(xlUp))
ws2.Columns(2).Insert
With rng1.Offset(0, 1)
     .FormulaR1C1 = "=MATCH(RC[-1],'" & ws1.Name & "'!C[2],0)"
     On Error Resume Next
    .Cells.SpecialCells(xlCellTypeFormulas, xlErrors).EntireRow.Delete
     On Error GoTo 0
End With

ws2.Columns(2).Delete

With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
End With
End Sub

- brettdj

Answer 4

注意：我没有足够的“声望”来添加我的评论，所以作为答案发布。感谢hnk提供的出色答案（长答案）。我有一个建议作为修改：

一旦您拆分了长字符串，并且在最后一个块超过设置的字符时，则在结尾处有“！”导致range方法出错。添加IF语句和MID可以确保没有这样的字符。

为了处理这个问题，请使用：

For i = LBound(DelStr_Cut) + 1 To UBound(DelStr_Cut)
    If Right(DelStr_Cut(i), 1) = "!" Then
        DelStr_Cut(i) = Mid(DelStr_Cut(i), 1, Len(DelStr_Cut(i)) - 1)
        Set DeleteRng = Union(DeleteRng, ActiveSheet.Range(DelStr_Cut(i)))
    Else
        Set DeleteRng = Union(DeleteRng, ActiveSheet.Range(DelStr_Cut(i)))
    End If
Next i

谢谢，Bakul

- Bakul Krishana