删除行子处理速度很慢答案

【问题标题】：Delete rows sub very slow to process删除行子处理速度很慢
【发布时间】：2019-02-20 15:19:32
【问题描述】：

我在 Excel 中构建了一个宏，它将来自多个输入选项卡的输入存储到数据库中（表格格式）。作为宏的一部分，我包含了一个 Sub 以删除给定年份 (CYear) 的任何先前条目，然后再为该年份编写新条目。

在工作簿的大小增加到大约 10MB 之前，这一直运行良好。代码的以下部分现在需要超过 1 小时才能运行。还有其他更快的方法吗？

Application.ScreenUpdating = False 和 Application.Calculation = xlCalculationManual 包含在较大的 Sub 中，r 将接近数千行。

Dim r As Long
Sheets("Database").Activate

For r = ActiveSheet.UsedRange.Rows.Count To 1 Step -1

    If Cells(r, "G") = Range("C5") Then
        ActiveSheet.Rows(r).EntireRow.Delete
    End If
Next

【问题讨论】：

尝试使用 Sheets("Database"). 而不是 activesheet。不确定，但您正在使用两种不同的方法来访问单元格内容，不确定您是否将range("c5").value 设置为变量，然后检查cells(r,"G") 或range("G" & r)。
用Union 构建一个Range，然后再构建一个Delete。

标签： excel vba

【解决方案1】：

删除工作表中的某些内容是一个相当缓慢的操作，并且取决于您要删除的行数（而且似乎很多），您应该将所有应该删除的内容收集到 Range-Variable 和一次性全部删除。

另一个方面是UsedRange 并不总是可靠的，如果运气不好，宏会检查最后一行 (=1048576) 中的所有内容，这也可能是一个问题。构造 .Cells(.Rows.Count, "G").End(xlUp).row 将获取 Col 'G' 中最后使用的行的行号。

试试下面的代码

Sub del()

    Dim r As Long
    Dim deleteRange As Range
    Set deleteRange = Nothing

    With ThisWorkbook.Sheets(1)
        For r = .Cells(.Rows.Count, "G").End(xlUp).row To 1 Step -1
            If .Cells(r, "G") = .Range("C5") Then
                If deleteRange Is Nothing Then
                    Set deleteRange = .Cells(r, "G")
                Else
                    Set deleteRange = Union(deleteRange, .Cells(r, "G"))
                End If
            End If
        Next
    End With

    If Not deleteRange Is Nothing Then
        deleteRange.EntireRow.Delete
    End If
End Sub

【讨论】：

谢谢，这就像一个魅力。关于 Union 方法的快速问题。这是否要求所有需要删除的行都是相邻的？或者它们之间是否也存在差距（例如不同的年份）。如果数据库按年份以外的任何内容排序，则可能会发生这种情况
中间可以有间隙，没问题。

【解决方案2】：

嘿，鲍勃，我发现当您处理数千行或数十万行时，您可能想尝试使用数组。他们非常快地做同样的事情，就像你在工作表上做的那样

试试这个：

Sub DeleteRows()

    Dim arr, arr1, yeartocheck As Integer, yearchecked As Integer, ws As Worksheet, i As Long, j As Long, x As Long

    Set ws = ThisWorkbook.Sheets("DataBase")
    yeartocheck = ws.Range("C5")

    arr = ws.UsedRange.Value 'the whole sheet allocated on memory

    ReDim arr1(1 To UBound(arr), 1 To UBound(arr, 2)) 'lets define another array as big as the first one

    For i = 1 To UBound(arr1, 2) 'headers for the final array
        arr1(1, i) = arr(1, i)
    Next i

    x = 2 'here starts the data on the final array (1 is for the headers)

    For i = 2 To UBound(arr) 'loop the first array looking to match your condition
        yearchecked = arr(i, 7)
        If yearchecked <> yeartocheck Then 'if they don't match, the macro will store that row on the final array
            For j = 1 To UBound(arr, 2)
                arr1(x, j) = arr(i, j)
            Next j
            x = x + 1 'if we store a new row, we need to up the x
        End If
    Next i

    With ws
        .UsedRange.ClearContents 'clear what you have
        .Range("A1", .Cells(UBound(arr1), UBound(arr, 2))).Value = arr1 'fill the sheet with all the data without the CYear
    End With


End Sub

【讨论】：