重寫VBA for循環更高效更快

Question

我已經編寫了下面的程序，它在單元格2D & 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：

爲了獲得更好的性能，請嘗試以下提示：

1. 使用數字索引代替涉及索引串。所以Cells(2, 4)比Cells(2, "D")快。欲瞭解更多信息，請參閱Are these novelty ways [and possibly the best way?] to refer a dynamic cell in VBA?。
2. 嵌套IF語句被認爲比含有邏輯語句的IF語句更快。
3. 在陣列中工作比在單元格範圍內工作要快。
4. 嘗試使用Application.ScreenUpdating = False,Application.Calculation = xlCalculationManual和Application.DisplayAlerts = False加快速度。請務必在末尾輸入Application.ScreenUpdating = True，Application.Calculation = xlCalculationAutomatic和Application.DisplayAlerts = True。
5. 或者，您可以使用自動篩選器以比使用循環語句更快地刪除行。你可能有興趣看到這個：Deleting entire row on criteria cannot handle 400,000 rows。