Question

我在下面编写了以下程序，该程序在单元格2D＆amp;中提供用户的开始日期和结束日期。 2E。程序将向后遍历行，删除不符合条件的行。我还能如何指导我的代码更高效，整体运行更快？有什么规则可以加快速度吗？它目前将在我的机器上在45秒内处理1164项。

Sub SpecialDates()

Dim n As Long, i As Long, j As Long, date1 As Date, date2 As Date, date3 As Long, startDate As Date, endDate As Date

n = Cells(Rows.Count, "A").End(xlUp).Row
j = 4

For i = n To 4 Step -1
    j = j + 1
    startDate = Cells(2, "D").Value
    endDate = Cells(2, "E").Value

    If Not IsEmpty(Cells(i, "AB").Value) And Not IsEmpty(Cells(i, "AE").Value) Then
        If Cells(i, "AE").Value >= startDate And Cells(i, "AE").Value <= endDate Then
            date1 = Cells(i, "AB").Value 'AB=Entry Date
            date2 = Cells(i, "AE").Value 'AE=Rec'd 'PRIMARY CHECKING DATE'
            date3 = Work_Days(date2, date1)
            If date3 >= 0 Then
                Cells(i, "BG").Value = date3
            Else
                Rows(i).EntireRow.Delete
            End If
        Else
            Rows(i).EntireRow.Delete
        End If
    Else
        Rows(i).EntireRow.Delete
    End If
Next i

End Sub

Answer 1

如果您愿意为了性能而牺牲可读性，请尝试一下我的代码：

Sub SpecialDates()

Dim n As Long, i As Long, j As Long, k As Long, Date1 As Date, Date2 As Date, Date3 As Long, StartDate As Date, EndDate As Date
Dim DataRow As Collection

Set DataRow = New Collection                        'Storage for the row address which will be deleted
n = Cells(Rows.Count, 1).End(xlUp).Row
StartDate = Cells(2, 4)
EndDate = Cells(2, 5)
DataDate1 = Range(Cells(4, 28), Cells(n, 28))
DataDate2 = Range(Cells(4, 31), Cells(n, 31))
ReDim DataDate3(1 To UBound(DataDate1), 1 To 1)

For i = LBound(DataDate1) To UBound(DataDate1)
    If DataDate1 <> vbNullString Then
        If DataDate2 <> vbNullString Then
            If DataBase2(i, 1) >= StartDate Then
                If DataBase2(i, 1) <= EndDate Then
                    Date1 = DataDate1(i, 1)
                    Date2 = DataDate2(i, 1)
                    Date3 = Work_Days(Date2, Date1)

                    If Date3 >= 0 Then
                        DataDate3(i, 1) = Date3
                    Else
                        DataRow.Add i + 3           'Store the row address which will be deleted
                    End If
                Else
                    DataRow.Add i + 3               'Store the row address which will be deleted
                End If
            End If
        Else
            DataRow.Add i + 3                       'Store the row address which will be deleted
        End If
    End If
Next

Cells(4, 59).Resize(UBound(DataDate1), 1) = DataDate3

For k = 1 To DataRow.Count Step -1
    Rows(DataRow(k)).EntireRow.Delete
Next

End Sub

<强> TIPS：

要获得更好的性能，请尝试以下提示：

使用数字索引而不是涉及字符串的索引。因此Cells(2, 4)比Cells(2, "D")快。有关详细信息，请参阅Are these novelty ways [and possibly the best way?] to refer a dynamic cell in VBA?。
嵌套的IF语句被认为比带有逻辑语句的IF语句更快。
在数组中工作比在单元格范围内工作要快。
尝试使用Application.ScreenUpdating = False，Application.Calculation = xlCalculationManual和Application.DisplayAlerts = False加快速度。请务必将Application.ScreenUpdating = True，Application.Calculation = xlCalculationAutomatic和Application.DisplayAlerts = True放在最后。
或者，您可以使用 AutoFilter 来删除行，而不是使用循环语句。您可能有兴趣看到这个：Deleting entire row on criteria cannot handle 400,000 rows。

更有效，更快速地重写VBA For循环

1 个答案: