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

Question

我目前有一个宏，如果我从 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

在尝试了很多不同的选项(包括下面列出的所有答案)之后。我意识到，无论采用什么方法，在我的普通笔记本电脑(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 秒。当然，只有当您的数据位于表中时，此方法才有效。

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

任意行数和基准结果的(很长)有效解决方案:

以下是通过删除行获得的基准测试结果(以秒为单位的时间与行数)。

这些行是干净的，并且在 D 列中包含来自 D1:D100000 的 volatile 公式

即对于 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个字符时抛出的错误。好像是known问题，正如我痛苦地发现的那样，它在 Excel 2013 中仍然存在。