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

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

Answer 2

最好在单个操作中删除大量单个行。 Rory已演示Union method创建一系列不连续的行，并通过一次Range.Delete操作删除。

虽然Union方法比循环查找要删除的行的各个行要好得多，但这仍然会受到CPU密集的删除（和转移）许多不连续数据行的操作的影响。如果行可以方便地移动到单个块中，则.Delete方法将更快地工作。 Range.Sort method可能看起来更有效，但总体来说会更快。

Option Explicit

Sub DeleteRows()

    Dim dtFrom As Date
    Dim dtUpto As Date
    Dim y As Long
    Dim d As Long, vDTs As Variant

    'appTGGL bTGGL:=False  '<~~ uncomment when finished debugging

    dtFrom = Sheets("Control Panel").Range("D5").Value2
    dtUpto = dtFrom + 6
    Sheet1.Range("D1") = "Scanning, Please wait..."

    'is this supposed to be Database or Sheet5? Are you mixing names and codenames?
    With Worksheets("Database")
        With .Cells(1, 1).CurrentRegion
            With .Resize(.Rows.Count - 1, 1).Offset(1, 0)
                vDTs = .Value2
                For d = LBound(vDTs, 1) To UBound(vDTs, 1)
                    vDTs(d, 1) = IIf(vDTs(d, 1) >= dtFrom And vDTs(d, 1) <= dtUpto, 1, 0)
                Next d
            End With
            With .Resize(.Rows.Count - 1, 1).Offset(1, .Columns.Count)
                .Cells = vDTs
            End With
        End With

        'reestablish the new currentregion
        With .Cells(1, 1).CurrentRegion
            .Cells.Sort key1:=.Columns(.Columns.Count), order1:=xlAscending, _
                        Orientation:=xlTopToBottom, Header:=xlYes
            d = Application.Match(1, .Columns(.Columns.Count), 0)
            'one big block of rows to delete
            .Cells(d, 1).Resize(.Rows.Count - d, 1).EntireRow.Delete
            'done with the helper column
            .Columns(.Columns.Count).EntireColumn.Delete
        End With

    End With

    appTGGL

End Sub

Sub appTGGL(Optional bTGGL As Boolean = True)
    Application.Calculation = IIf(bTGGL, xlCalculationAutomatic, xlCalculationManual)
    Application.EnableEvents = bTGGL
    Application.DisplayAlerts = bTGGL
    Application.ScreenUpdating = bTGGL
    Application.Cursor = IIf(bTGGL, xlDefault, xlWait)
    Debug.Print Timer
End Sub

我通过在50,000行上测试这个问题来放大这个问题（20倍于你正在处理的2500行表）并且只用了几秒钟。代码看起来像是做了很多工作但是它在记录时间内完成了任务。

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

2 个答案: