宏不断使 Excel 崩溃答案

【问题标题】：Macro keeps crashing Excel宏不断使 Excel 崩溃
【发布时间】：2018-06-25 19:43:53
【问题描述】：

我正在编写一个宏，它将一般日期列表 (Sheet1) 与办公室开放的“营业日期”列表 (COF) 进行比较。因此，如果总列表上的日期不在营业日期列表中，我的宏应该尝试找到与总列表日期最近的营业日期，并将其分配到右侧的列中。单元格中的内容格式与日期相同。不幸的是，每次我尝试运行宏时，Excel 都会完全冻结，我必须强制退出，而不会出现错误消息或任何内容。

Sub BusinessDate()
'Finds the closest business date to a lease date, solving for weekends
Dim businessday As Boolean
Dim shift As Integer

For Each Cell1 In Worksheets("Sheet1").Range("B2:B10000")
'Change 10000 to maximum number of rows if > 10000 rows
    businessday = False

    For Each Cell2 In Worksheets("COF").Range("A2:A10000")

        If Cell1.Value = Cell2.Value Then
            businessday = True
            Cell1.Offset(0, 1).Value = Cell1.Value
        End If

    Next Cell2
    shift = 1
    Do While businessday = False And shift < 6

        For Each Cell2 In Worksheets("COF").Range("A2:A10000")

            If Cell1.Value + shift = Cell2.Value Then
                businessday = True
                Cell1.Offset(0, 1).Value = Cell1.Value + shift
                Exit Do
            End If

        Next Cell2

        For Each Cell2 In Worksheets("COF").Range("A2:A10000")

            If Cell1.Value - shift = Cell2.Value Then
                businessday = True
                Cell1.Offset(0, 1).Value = Cell1.Value - shift
            End If

        Next Cell2
        shift = shift + 1
        Loop
    Next Cell1
End Sub

我的代码写错了吗？

谢谢！

【问题讨论】：

您可以使用ElseIf 或Case 来缩短它。可以帮助您更好地遵循您的逻辑并查看您的问题
由于您在很多单元格中循环，如果您不必担心有人在运行时尝试使用 Excel，您可以尝试在每个 Next 之前添加 DoEvents线......
另外，将A10,000 更改为动态的最后一行。将循环限制在必要的最少数量。
也许在开始时将计算转为手动并关闭屏幕更新？如果您还使用数组来存储数据，然后比较它，并记录那些相等的单元格怎么办？此外，您真的需要两次运行超过 10,000 行吗？（或者，这不是真正的 10,000 * 10,000，因为您要检查行中的每个单元格，对照整个另一列，然后移动到第二个单元格等）
你真的有 10,000 个日期要检查吗？这几乎是 30 年的数据（商务日期要多得多）。您当前正在进行 10,000 * 10,000 次比较，即 100,000,000 次操作。如果您可以将您的工作表缩减到唯一的日期，它将为您节省大量的处理时间。

标签： vba excel

【解决方案1】：

事实证明，循环太大，Excel 并没有崩溃，而是需要很长时间才能完成宏。您可以通过使用变量来表示每张表中的最后一行数据来缩短流程，如下所示：

Dim lastrowsheet1 As Integer   
lastrowsheet1 = Worksheets("Sheet1").Range("B1").End(xlDown).row        
For Each Cell1 In Worksheets("Sheet1").Range("B2:B" & lastrowsheet1)

此外，包括一个 Exit For 语句以避免在找到匹配项后循环遍历一系列单元格的其余部分，大大减少了宏完成所需的时间：

If Cell1.Value = Cell2.Value Then 
    businessday = True 
    Cell1.Offset(0, 1).Value = Cell1.Value 
    Exit For 
End If

此外，如果您知道用户在宏运行时不会使用 Excel，DoEvents 也会很有帮助

【讨论】：