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