VBA嵌套循环崩溃的Excel

我目前正试图创build一个列表中的所有可能的组合条目从两个单独的工作表，但每当我尝试运行它，约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

尝试这个。 您不需要继续select工作表，因为这将会增加额外的开销。 而只是像这样引用单元格：

 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