删除行的过程缓慢 - 如何加快速度？

Question

我的工作簿中有几个宏。这是唯一一个在 2500 行的工作表上似乎真的很慢 3-5 分钟的方法。

目的是如果 Row 在日期 dtFrom 和 dtUpTo 之间，则删除整行。

我添加了暂停和恢复计算，并略微提升了它

任何人都对如何加快速度有任何想法？

Sub DeleteRows
    '--- Pause Calculations:
    Application.Calculation = xlManual
    '----- DELETE ROWS -----
    Dim dtFrom As Date
    Dim dtUpto As Date
    Dim y As Long
    Dim vCont As Variant
    dtFrom = Sheets("Control Panel").Range("D5").Value
    dtUpto = dtFrom + 6
    Sheet1.Range("D1").Value2 = "Scanning, Please wait..."
    With Sheets("Database")
        For y = Sheet5.Cells(Sheet5.Rows.Count, 2).End(xlUp).Row + 1 To 2   Step -1
            vCont = .Cells(y, 1).Value
            If Not IsError(vCont) Then
                If vCont >= dtFrom And vCont <= dtUpto Then
                    .Rows(y).EntireRow.Delete
                End If
            End If
        Next
    End With
    '--- Resume Calculations:
    Application.Calculation = xlAutomatic
   End Sub

谢谢！

Answer 1

最后尝试只对所有相关行执行一次删除操作：

Sub DeleteRows()
'--- Pause Calculations:
    Application.Calculation = xlManual
    '----- DELETE ROWS -----
    Dim dtFrom                As Date
    Dim dtUpto                As Date
    Dim y                     As Long
    Dim vCont                 As Variant
    Dim rDelete As Range
    dtFrom = Sheets("Control Panel").Range("D5").Value
    dtUpto = dtFrom + 6
    Sheet1.Range("D1").Value2 = "Scanning, Please wait..."
    With Sheets("Database")
        For y = Sheet5.Cells(Sheet5.Rows.Count, 2).End(xlUp).Row + 1 To 2 Step -1
            vCont = .Cells(y, 1).Value
            If Not IsError(vCont) Then
                If vCont >= dtFrom And vCont <= dtUpto Then
                    If rDelete Is Nothing Then
                        Set rDelete = .Rows(y)
                    Else
                        Set rDelete = Union(rDelete, .Rows(y))
                    End If
                End If
            End If
        Next
    End With
    If Not rDelete Is Nothing Then rDelete.EntireRow.Delete
    '--- Resume Calculations:
    Application.Calculation = xlAutomatic
End Sub

注意：您也可以在此处使用自动过滤器。