Почему UserForm "не отвечает" Во время выполнения в VBA Excel?

Я очень новичок в VBA Excel, и я знаю только то, что мне нужно для этой задачи форматирования отчета.

Я почти закончил с моей задачей, но когда я запускаю программу и запускаю прогресс, хотя она работает успешно, GUI не отвечает в течение минуты. Я делюсь своим кодом здесь, что-то не так с ним? Вы можете предложить мне какую-нибудь передовую практику? Я не хочу, чтобы он замерз, потому что это будет выглядеть плохо для моего менеджера.

просто чтобы прояснить, "не отвечая" я имею в виду, что он зависает на экране и говорит "не отвечает" на его фрейме windows, и когда я нажимаю на него, он дает сообщение вроде этого:

enter image description here

*ps: лист, который я получаю записи, имеет 20997 строк и 7 столбцов, и я делаю некоторые записи на другой лист с тем же размером файла и 20997 строк 23 столбца. И мой GUI очень прост, у него нет ничего, кроме командной кнопки, которая запускает прогресс.

Как я могу это исправить?

3 ответов


вы можете предотвратить замораживание окна excel, поставив

DoEvents

внутри вашего цикла.


это происходит потому, что процедура очень занят работой. Например ваш 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:

учитывая, что столбцы между теми, которые вы изменяете, являются только текстовыми или пустыми ячейками, вы можете:

  1. читать весь диапазон в массив.
  2. затем измените массив таким же образом, как вы в настоящее время изменение клеток.
  3. после того, как изменения будут сделаны, снова сбросьте всю матрицу в диапазоне.'

например:

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