Question

我在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

Answer 1

删除工作表中的内容是一项相当缓慢的操作，并且根据要删除的行数（似乎很多），您应该收集应该在Range中删除的所有内容-变量并立即将其全部删除。

另一方面是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

Answer 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

删除行子非常慢

2 个答案: