Excel 使用VBA删除行的最有效方法

我目前有一个宏，如果从XML文档创建的ID列表中不存在该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

---

使用任何涉及

entireclumn.Delete

的操作，或者在我的笔记本电脑上手动选择行并删除它大约需要20-30秒。当然，此方法仅在数据位于表中时有效。

简短回答：

使用类似

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行，以下代码将非常有效。超出这个范围就会抛出一个错误。有关有效处理任意行数的代码，请参见下面的超长答案

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

针对任意行数和基准测试结果的（非常长的）有效解决方案：

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

这些行位于一张干净的表格上，在D列中包含D1:D100000中的挥发性公式

i、 e.对于100000行，它们有一个公式

=SIN（RAND（））

代码很长，也不太漂亮，但它将

DelStr

拆分为250个字符的子字符串，并使用这些子字符串形成一个范围。然后在一次操作中删除新的

DeleteRng

范围

删除的时间可能取决于单元格的内容。测试/基准测试与一点直觉一致，表明以下结果

• 稀疏行/空单元格删除速度最快
• 具有值的单元格需要更长的时间
• 带有公式的单元格需要更长的时间
• 在其他单元格中输入公式的单元格会占用最长的时间，因为删除这些单元格会触发

  #Ref

  引用错误

代码：

在空白工作表中生成公式的代码为

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中仍然存在。

此代码使用自动筛选，比在行中循环快得多。

我每天都使用它，应该很容易找到它。

只需将要查找的内容和要搜索的列传递给它。

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

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

---

在这种情况下，可以使用一个简单的工作公式来查看待测试范围内的每个值（附表a列）是否存在于misc的F列中

在

B4

中，它将

=匹配（A4，misc！D:D，0）

这可以手动使用，也可以与代码一起有效删除，因为如果不存在匹配项，则design公式将返回错误，我们可以使用

VBA

有效删除以下任一项：

• AutoFilter

• 特殊单元

  （设计件*）

在xl2007中，请注意可以使用

SpecialCells

代码

注意：我没有足够的“声誉”来添加我的评论，因此将其作为答案发布。感谢您的精彩回答（长答案）。我有一个建议：

分割长字符串后，如果最后一个块大于设置的字符，那么它的末尾将出现“！”，这将引发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

一个很好的起点是不要在某个范围内循环，将其复制到一个变体数组中并循环该数组。谢谢你的提示，我会尝试一下，看看它是如何工作的out@Harry12345，感谢反馈，该方法可以删除所有列，而不仅仅是一列，我只填写了1列用于测试目的。将删除包含所有列的整行。基准测试是针对任何其他方法客观地衡量效率。请务必在下面的答案中查看我的评论。因此，要高效地删除一行，只需使用

ActiveSheet.Range（DelStr）.delete

where

DelStr=“15:15”

即可删除包含所有列的第15行，等等。这忽略了OP正在使用的循环位于要查找的各个字符串上-OP已经在使用

find

查找每个搜索字符串。此例程在一列中查找vSearch的所有实例。不需要遍历列中的每个单元格来查找每个实例。这只是一个如何使用自动筛选的示例，我发现这是一个比遍历一系列单元格时使用查找快得多的例程。自动过滤是一个很好的方法。我指出OP有多个用于行删除的值，因此需要多次调用例程。这部分是OPs代码中当前的瓶颈。由于代码在

DelStr

长度上很快崩溃，我的测试是255个字符，或者

DelRows（1到46）

@brettdj非常好，我应该在发布之前用更长的字符串进行测试。我的错。我已经更新了代码以包含任意长度的字符串和删除的行数。我还包括了一个基准测试

Sub TestTimeForDeletion()

        Call FillRandom

        Dim Time1 As Single, Time2 As Single
        Time1 = Timer

        Call DeleteRows

        Time2 = Timer
        MsgBox (Time2 - Time1)
End Sub

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

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

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