使用VBA删除行的最有效的方式 [英] Most efficient way to delete row with VBA

问题描述

我目前拥有一个宏，用于删除记录，如果ID从我从XML文档创建的ID列表中不存在。它的工作就像我想要的那样，但是我在电子表格中有超过1000列（一年中的每一天，直到2015年底），所以删除行需要几年的时间，它只能做1或2，然后再说Excel耗尽资源，不得不停止。下面是我用于宏的代码，是否有另一种方法可以这样做，以便Excel不运行资源？

I currently have a macro that I use to delete a record if the ID doesn't exist in a list of ID's I created from an XML document. It does work like I want it to, however I have over 1000 columns in the spreadsheet (one for each day of the year until end of 2015) so it takes ages to delete the row and it can only do 1 or 2 before it says "Excel ran out of resources and had to stop". Below is the code I'm using for the macro, is there another way I can do this so that Excel doesn't run of of resources?

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

尝试了许多不同的选项，包括下面列出的所有答案。我已经意识到，无论什么方法，删除具有〜1100列的行将在我的平均笔记本电脑（2.20 Ghz，4GB RAM）上花费一些时间。由于大部分行都是空的，所以我找到了更快的替代方法。我只是清除包含数据（A：S）的单元格，然后调整表的大小，以删除我刚删除数据的行。这个最终结果与 wholeColumn.Delete 完全相同。以下是我现在使用的代码

After trying lots of different options, including all the answers listed below. I have realized that whatever the method is, deleting a row with ~1100 columns is going to take a while on my average laptop (2.20 Ghz, 4GB RAM). Since the majority of the rows are empty I have found alternative method which is a lot faster. I just clear the cells which contain data (A:S) and then resize the table to remove the row where I just deleted the data from. This end result is exactly the same as entireColumn.Delete. Below is the code I'm using now

'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")

code> EntireColumn.Delete 或者只需手动选择行并删除它，笔记本电脑需要大约20-30秒。当然，这个方法只有在你的数据在表格中才有效。

Using anything involving EntireColumn.Delete or just manually selecting the row and deleting it takes about 20-30 seconds on my laptop. Of course this method only works if your data is in a table.

推荐答案

简短的答案

使用类似

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行，以下代码非常有效。超越它会抛出一个错误。对于处理任意行数的代码有效地查看

Important: If you have ~ 30 / 35 rows to delete, the following code works very efficiently. Beyond which it would throw up an error. For code to handle arbitrary number of rows efficiently see the very long answer below this.

如果您有一个功能，可以列出哪些要删除的行，请尝试下面的代码。这是我用来以最小的开销非常有效地删除多行。 （该示例假设您已经通过某些程序获取了需要删除的行，此处我手动将其添加到其中）：

If you have a function which lets you list out which rows you want to delete, try the code below. This is what I use to very efficiently delete multiple rows with minimum overhead. (the example assumes that you've obtained the rows you need to delete through some program, here I manually feed them in):

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

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

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

Here are the benchmark results obtained by deleting rows (Time in seconds vs. no. of rows).

行位于干净的表格上，并且在D1的D列中包含易失性公式：D100000

The rows are on a clean sheet and contain a volatile formula in the D column from D1:D100000

即对于100,000行，它们具有公式 = SIN（RAND（））

i.e. for 100,000 rows, they have a formula =SIN(RAND())

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

The code is long and not too pretty, but it splits the DelStr into 250 character substrings and forms a range using these. Then the new DeleteRng range is deleted in a single operation.

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

The time to delete may depend on the contents of the cells. The testing/benchmarking, in congruence with a bit of intuition suggests the following results.

• 稀疏行/空单元删除最快


• 具有值的单元格需要更长的时间


• 具有公式的单元格更长时间


• 在其他单元格中输入公式的单元格最长，因为他们的删除触发 #Ref 参考错误。

• Sparse rows/empty cells delete fastest
• Cells with values take somewhat longer
• Cells with formulas take even longer
• Cells which feed into formulas in other cells take longest as their deletion triggers the #Ref reference error.

代码： / p>

Code:

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

生成空白表中公式的代码是

The code to generate the formulas in a blank sheet is

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

生成代码基准测试以上是

And the code to generate the benchmark results above is

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 。

Note: Many thanks to brettdj for pointing out the error which gets thrown when the length of DelStr exceeding 255 characters. It seems to be a known problem and as I painfully found out, it still exists for Excel 2013.

这篇关于使用VBA删除行的最有效的方式的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！