Выполнение кода VBA делает Excel не реагирующим, а затем восстанавливает - PullRequest
Новая
       14

Выполнение кода VBA делает Excel не реагирующим, а затем восстанавливает

0 голосов
/ 09 мая 2019

Этот код ищет, чтобы увидеть, какие из записей в столбце A не отображаются в столбце B. Затем он записывает эту запись столбца A вместе со смежными записями столбца B и столбца C в столбцы F, G, H.

После выполнения он возвращается к итерации 350/83118, а затем останавливается, но восстанавливается примерно через 20 минут после завершения итераций. Как видите, режим расчета установлен на ручной, и я попытался отключить обновление экрана, отображение разрывов страниц и событий, но он все еще зависает.

Есть идеи, чтобы остановить его? Я не возражаю против того, чтобы выполнение кода занимало больше времени, так как оно не зависает и не успокаивает пользователя с постоянно увеличивающимся числом итераций. 

Sub MacroToCreateReducedBoMList()


Dim LR As Long, i As Long, j As Long
Dim LastRow As Long
Dim StartCell As Range
Dim Calc_Setting As Long
Dim StartTime As Double
Dim MinutesElapsed As String


StartTime = Timer
Calc_Setting = Application.Calculation
Application.Calculation = xlCalculationManual

'Turning off events temporarily'
Dim EventState As Boolean
EventState = Application.EnableEvents
Application.EnableEvents = False

'Turning off page breaks temporarily'
Dim PageBreakState As Boolean
PageBreakState = ActiveSheet.DisplayPageBreaks
ActiveSheet.DisplayPageBreaks = False


Set StartCell = Range("A1")
'Find Last Row'
LastRow = StartCell.SpecialCells(xlCellTypeLastCell).Row

j = 2

Application.ScreenUpdating = False

Range("F2:H130000").ClearContents

'MAIN CODE'
For i = 2 To LastRow
If WorksheetFunction.CountIf(Range("B:B"), Range("A" & i)) = 0 Then
    Debug.Print Range("A" & i)
    Cells(j, 6) = Range("A" & i)
    Cells(j, 7) = Range("B" & i)
    Cells(j, 8) = Range("C" & i)
    j = j + 1
End If

'Message to user about current iteration'
Application.StatusBar = "Current iteration: " & i & "/" & LastRow & ".  
Please be patient, code takes roughly 20 minutes to execute, go get a coffee."

Next i

Application.ScreenUpdating = True
Application.Calculation = Calc_Setting

'Turning events back on'
Application.EnableEvents = EventState

'Turning page breaks back on'
ActiveSheet.DisplayPageBreaks = PageBreakState

'Determine how many seconds code took to run
 MinutesElapsed = Format((Timer - StartTime) / 86400, "hh:mm:ss")

'Notify user in minutes
MsgBox "This code ran successfully in " & MinutesElapsed & " minutes", vbInformation

End Sub

Ответы [ 2 ]

2 голосов
/ 09 мая 2019

Если Excel слишком долго запускает макрос, то Windows будет считать, что он больше не отвечает, и остановит экран.Вы можете уменьшить это с помощью DoEvents, что позволит Excel «регистрироваться» в Windows.

Однако, так как этот делает «регистрацию» и выполняет события, это такжеОтносительно медленная функция - поэтому не называйте ее каждую итерацию цикла.Например, приведенная ниже строка кода запускает его с интервалом в 300 строк: 

If (i mod 300) = 0 Then DoEvents

Вы также можете включить Обновление экрана, принудительно обновить экран, а затем снова отключить Обновление экрана длявизуальное обновление.Добавление, которое дает вам это: 

If (i mod 300) = 0 Then
    Application.ScreenUpdating = True
    Application.WindowState = Application.WindowState 'Force Screen Update
    Application.ScreenUpdating = False
    DoEvents 'Check in with Windows
End If
2 голосов
/ 09 мая 2019

Вы должны поместить Application.ScreenUpdating = true в цикл for и false после обновления сообщения: 

'Message to user about current iteration'
Application.ScreenUpdating = true
Application.StatusBar = "Current iteration: " & i & "/" & LastRow & _  
    "Please be patient, code takes roughly 20 minutes to execute, go get a coffee."
Application.ScreenUpdating = false

также, worksheetFunction.CountIf, вероятно, инициирует ручной пересчет листа.

...