更高效、更快地重写VBA For循环



我已经编写了下面的程序,它在单元格2D &2 e。程序将向后遍历这些行,删除不符合条件的行。除此之外,我还能如何引导我的代码变得更高效、运行得更快呢?有什么加快速度的方法吗?目前在我的机器上,它可以在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

如果你愿意为了性能而牺牲可读性,那么试试我的代码:

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

提示:

要获得更好的性能,请尝试以下提示:

  1. 使用数字索引代替包含字符串的索引。所以Cells(2, 4)Cells(2, "D")快。欲了解更多信息,请参见这些新颖的方法[可能是最好的方法吗?在VBA中引用动态单元格?
  2. 嵌套IF语句被认为比带有逻辑语句的IF语句更快。
  3. 在数组中工作比在单元格范围中工作快。
  4. 尝试使用Application.ScreenUpdating = False, Application.Calculation = xlCalculationManualApplication.DisplayAlerts = False来加快速度。只是一定要把Application.ScreenUpdating = True, Application.Calculation = xlCalculationAutomaticApplication.DisplayAlerts = True放在最后。
  5. 或者,您可以使用AutoFilter来比使用循环语句更快地删除行。您可能对以下内容感兴趣:在标准上删除整行不能处理400,000行。

最新更新