如果单击鼠标左键，为什么我的代码执行得更快？

Question

我有一些过程需要花费不同的时间来执行。如果我什么也不做，则执行时间将延长5倍。当我在执行相同过程的过程中单击鼠标左键时，它会在几秒钟后完成。谁能解释为什么会发生这种情况以及如何防止这种情况将来发生？

我试图将代码中的数组设置为空。

Sub Main()
    Dim NumberOfCompanies As Long
    Dim LastRow As Long
    Dim StartTime As Double
    Dim MinutesElapsed As String
    StartTime = Timer
    '////////////////////////////
    Sheets("Process").Activate
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    ...
    Call Result
    ...
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Sheets("Result").Activate
    '\\\\\\\\\\\\\\\\\\\\\\\\\\\
    MinutesElapsed = Format((Timer - StartTime) / 86400, "hh:mm:ss")
    LastRow = CountRow("Result", 1)
    NumberOfCompanies = Sheets("Result").Cells(LastRow, "A").Value
    MsgBox "There are " & NumberOfCompanies & " candidates for Nace change!" & " This code ran successfully in " & MinutesElapsed & " minutes", vbInformation
End Sub


Sub Result()
    Dim CompanyNumbersArray As Variant
    Dim StartingRow As Variant
    Dim EndingRow As Variant
    Dim LastRow As Long
    Dim ArraySize As Long
    Dim Count As Long
    Dim i As Long
    Dim j As Long
    Dim CompanyRows As Long
    Dim k As Long
    Dim Background As Boolean
    Dim CurrentCompany As String
    Dim NextCompany As String
    Dim Str As String
    Sheets("Process").Activate
    Sheets("Result").Range("A2:XFD1048576").Clear
    Sheets("NoResult").Range("A2:XFD1048576").Clear
    LastRow = CountRow("Process", 1)
    CompanyNumbersArray = Sheets("Process").Range("A2:A" & LastRow)
    StartingRow = Sheets("Process").Range("O2:O" & LastRow).Value
    EndingRow = Sheets("Process").Range("P2:P" & LastRow).Value
    Sheets("Process").Range("A2:S" & LastRow).Copy Destination:=Sheets("Result").Range("A2:S" & LastRow)
    Sheets("Process").Range("A2:S" & LastRow).Copy Destination:=Sheets("NoResult").Range("A2:S" & LastRow)
    Sheets("Result").Range("A:T").Borders(xlInsideHorizontal).LineStyle = xlLineStyleNone
    Sheets("NoResult").Range("A:T").Borders(xlInsideHorizontal).LineStyle = xlLineStyleNone
    ArraySize = UBound(CompanyNumbersArray)
    Count = 1
    For i = 1 To ArraySize - 1
        CurrentCompany = CompanyNumbersArray(i, 1)
        NextCompany = CompanyNumbersArray(i + 1, 1)
        If CurrentCompany <> NextCompany Then
            Count = Count + 1
        End If
    Next
    Str = "Result: Copying data to sheets /Result/ and /NoResult/ "
    Call ProgressOfCode(1, 4, Str)
    i = 1
    For j = 1 To Count
        Background = True
        CompanyRows = EndingRow(i, 1) - StartingRow(i, 1) + 1
        For k = 0 To CompanyRows - 1
            If (Sheets("Process").Range("R" & i + 1 + k).Interior.ColorIndex = xlNone) Then
                Background = False
            Else
                Background = True
                Exit For
            End If
        Next
        If Background = False Then
            Sheets("Result").Range("A" & StartingRow(i, 1) & ":T" & EndingRow(i, 1)).Value = vbNullString
            Sheets("Result").Range("A" & StartingRow(i, 1) & ":T" & EndingRow(i, 1)).Interior.Color = xlNone
        ElseIf Background = True Then
            Sheets("NoResult").Range("A" & StartingRow(i, 1) & ":T" & EndingRow(i, 1)).Value = vbNullString
            Sheets("NoResult").Range("A" & StartingRow(i, 1) & ":T" & EndingRow(i, 1)).Interior.Color = xlNone
        End If
        If EndingRow(i, 1) < LastRow Then
            i = EndingRow(i, 1)
        End If
    Next
    Str = "Result: Copying data to sheets /Result/ and /NoResult/ "
    Call ProgressOfCode(2, 4, Str)
    Sheets("Result").Activate
    Sheets("Result").Range("A:T").Sort Key1:=Range("N2"), key2:=Range("A2"), Order1:=xlAscending, Order2:=xlAscending, Header:=xlYes, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal, DataOption2:=xlSortNormal
    Sheets("NoResult").Activate
    Sheets("NoResult").Activate
    Sheets("NoResult").Range("A:T").Sort Key1:=Range("N2"), key2:=Range("A2"), Order1:=xlAscending, Order2:=xlAscending, Header:=xlYes, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal, DataOption2:=xlSortNormal
    Call ResultRestoreLines("Result")
    Str = "Result: Copying data to sheets /Result/ and /NoResult/ "
    Call ProgressOfCode(3, 4, Str)
    Call ResultRestoreLines("NoResult")
    Str = "Result: Copying data to sheets /Result/ and /NoResult/ "
    Call ProgressOfCode(4, 4, Str)
    Application.StatusBar = "Done!"
    Application.Wait (Now + TimeValue("00:00:01"))
    Application.StatusBar = False
End Sub

Private Sub ResultRestoreLines(SheetName As String)
    Dim CompanyNumbersArray As Variant
    Dim CompanyStructureArray As Variant
    Dim LastRow As Long
    Dim ArraySize As Long
    Dim Count As Long
    Dim i As Long
    Dim CurrentRow As Long
    Dim CurrentCompany As String
    Dim NextCompany As String
    LastRow = CountRow(SheetName, 1)
    CompanyNumbersArray = Sheets(SheetName).Range("A2:A" & LastRow).Value
    CompanyStructureArray = Sheets(SheetName).Range("N2:N" & LastRow).Value
    ArraySize = UBound(CompanyNumbersArray)
    Count = 1
    For i = 1 To ArraySize - 1
        CurrentCompany = CompanyNumbersArray(i, 1)
        NextCompany = CompanyNumbersArray(i + 1, 1)
        If CurrentCompany <> NextCompany Then
            Count = Count + 1
        End If
    Next
    CurrentRow = 2
    For i = 1 To Count
        Sheets(SheetName).Range("A" & CurrentRow & ":P" & CurrentRow + CompanyStructureArray(CurrentRow - 1, 1) - 1).Borders(xlEdgeBottom).LineStyle = xlContinuous
        CurrentRow = CurrentRow + CompanyStructureArray(CurrentRow - 1, 1)
    Next
    LastRow = CountRow(SheetName, 1)
    Sheets(SheetName).Cells(LastRow + 2, "A").Value = Count
End Sub

我希望相同的代码运行相同的时间。