VBA嵌套for循環崩潰Excel

Question

我目前正試圖創建一個列表，從兩個單獨的工作表，所有可能的條目組合，但每當我嘗試運行它，大約20秒後Excel崩潰。有沒有人有任何提示如何更有效地做到這一點，或一種方法來使這項工作？謝謝！

Sub Create() 
Dim dates, groups, current As Integer 
Dim dateValue As Date 
Dim groupValue As String 
Dim cell As Long 

Application.ScreenUpdating = False 
Sheets(3).Cells.Clear 
cell = 1 

For dates = 1 To 730 

    Sheets(1).Select 
    dateValue = Cells(dates, 1).Value 

    For groups = 1 To 155 

     Application.StatusBar = dateValue & " " & groupValue 

     Sheets(2).Select 
     groupValue = Cells(groups, 1).Value 

     Sheets(3).Select 

     Cells(cell, 1) = dateValue 
     Cells(cell, 2) = groupValue 

     cell = cell + 1 

    Next groups 

Next dates 

Application.StatusBar = False 
Application.ScreenUpdating = True 

End Sub 

Answer 1

刪除.Select調用。

groupValue = Sheets(2).Cells(groups, 1).Value 

是優於

Sheets(2).Select 
groupValue = Cells(groups, 1).Value 

.Select是緩慢而昂貴的和不必要的。

狀態欄是否實際更新？這樣做10萬次同樣是一個瓶頸;使用mod計數器更新每第n次迭代。

Answer 2

試試這個。您不需要繼續選擇工作表，因爲這會增加額外的開銷。取而代之的是像這樣引用單元格：

Sub Create() 
Dim dates, groups, current As Integer 
Dim dateValue As Date 
Dim groupValue As String 
Dim cell As Long 

Application.ScreenUpdating = False 
Sheets(3).Cells.Clear 
cell = 1 

For dates = 1 To 730 

    dateValue = Sheets(1).Cells(dates, 1).Value 

    For groups = 1 To 155 

     Application.StatusBar = dateValue & " " & groupValue 

     groupValue = Sheets(2).Cells(groups, 1).Value 

     Sheets(3).Cells(cell, 1) = dateValue 
     Sheets(3).Cells(cell, 2) = groupValue 

     cell = cell + 1 

    Next groups 

Next dates 

Application.StatusBar = False 
Application.ScreenUpdating = True 

End Sub