Почему UserForm "не отвечает" Во время выполнения в VBA Excel?
Я очень новичок в VBA Excel, и я знаю только то, что мне нужно для этой задачи форматирования отчета.
Я почти закончил с моей задачей, но когда я запускаю программу и запускаю прогресс, хотя она работает успешно, GUI не отвечает в течение минуты. Я делюсь своим кодом здесь, что-то не так с ним? Вы можете предложить мне какую-нибудь передовую практику? Я не хочу, чтобы он замерз, потому что это будет выглядеть плохо для моего менеджера.
просто чтобы прояснить, "не отвечая" я имею в виду, что он зависает на экране и говорит "не отвечает" на его фрейме windows, и когда я нажимаю на него, он дает сообщение вроде этого:
*ps: лист, который я получаю записи, имеет 20997 строк и 7 столбцов, и я делаю некоторые записи на другой лист с тем же размером файла и 20997 строк 23 столбца. И мой GUI очень прост, у него нет ничего, кроме командной кнопки, которая запускает прогресс.
Как я могу это исправить?
3 ответов
это происходит потому, что процедура очень занят работой. Например ваш Sub TheLoop()
обращается к 20995 x 16 раз ячейке, чтобы написать на них строку. Взаимодействие VBA с Excel происходит медленно.
есть несколько вещей, которые вы можете сделать, чтобы сделать процедуру быстрее.
1.Перед запуском процедуры отключите обработчики событий, обновление экрана и вычисления. В конце процедуры снова восстановите настройки.
'Disable'
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'...... Code'
'Enable'
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
2.Вы можете оптимизировать the Sub TheLoop
. Вместо того, чтобы писать сразу в ячейках, запишите значения внутри массива. После того, как массив заполнен значениями, назначьте значения массива диапазону, который вам нужен.
например:
Dim ResultValues() As String
Dim j As Long
ReDim ResultValues(2 To 20997, 1 To 3)
For j = 2 To 20997
ResultValues(j, 1) = "New Defect"
ResultValues(j, 2) = "3"
ResultValues(j, 3) = "2"
Next j
With ThisWorkbook.Worksheets("myWorksheet")
.Range(.Cells(2, 3), .Cells(20997, 5)) = ResultValues
End With
EDIT:
учитывая, что столбцы между теми, которые вы изменяете, являются только текстовыми или пустыми ячейками, вы можете:
- читать весь диапазон в массив.
- затем измените массив таким же образом, как вы в настоящее время изменение клеток.
- после того, как изменения будут сделаны, снова сбросьте всю матрицу в диапазоне.'
например:
Sub TheLoop()
Dim arrRangeValues() as Variant
Dim j as Long
arrRangeValues= Range("A2:V20997").Value2
For j = 2 To 20997
arrRangeValues(j, 1) = "Defect" 'Cells(row_index , column_index)'
arrRangeValues(j, 3) = "New Defect"
arrRangeValues(j, 4) = "3" ' this one also might be empty'
arrRangeValues(j, 5) = "2" ' this one also might be empty'
arrRangeValues(j, 7) = "Name Surname"
arrRangeValues(j, 8) = arrRangeValues(j, 7)
arrRangeValues(j, 16) = arrRangeValues(j, 7)
...
arrRangeValues(j, 10) = " http://SERVER_NAME:8888/PROJECT_NAME/ "
Next j
Range("A2:V20997").Value2 = arrRangeValues
End Sub
хорошо, я считаю, что нашел лучшее решение для этого. а):)
вместо использования цикла for в подпрограмме TheLoop я удалил цикл и изменил его, как показано ниже. Это делает его невероятно быстрее, когда я сравниваю его с моим первым кодом eventhough я не отключил свойства события, и теперь он не замерзает.
Sub TheLoop()
Cells(2, 1).Resize(20996) = "Defect"
Cells(2, 3).Resize(20996) = "New Defect"
Cells(2, 4).Resize(20996) = "3"
Cells(2, 5).Resize(20996) = "2"
Cells(2, 7).Resize(20996) = "Name Surname"
Cells(2, 8).Resize(20996) = "Name Surname"
Cells(2, 9).Resize(20996) = "FALSE"
Cells(2, 10).Resize(20996) = " http://SERVER_NAME:8888/PROJECT_NAME/ "
Cells(2, 12).Resize(20996) = "Software Quality"
Cells(2, 13).Resize(20996) = "Unsigned"
Cells(2, 14).Resize(20996) = "Software Quality"
Cells(2, 15).Resize(20996) = "1"
Cells(2, 16).Resize(20996) = "Name Surname"
Cells(2, 18).Resize(20996) = "Software Quality"
Cells(2, 20).Resize(20996) = "Development"
Cells(2, 22).Resize(20996) = " TYPE YOUR MODULE'S NAME TO HERE"
End Sub