Код VBA работает быстро и безупречно в Excel 2010, но для добавления одной записи в Excel 2016 или более поздней требуется 30 секунд

Question

Это мой первый пост с переполнением стека, поэтому, пожалуйста, дайте мне знать, если я делаю что-то не так. У меня интересная ситуация, когда приведенный ниже код работает почти мгновенно на Windows 7 с использованием Excel 2010, и у нас не было проблем с ним в течение многих лет, но теперь для добавления записи на Windows 10 с использованием Excel требуется почти 30 секунд 2016 и / или Office 365. Это вызывает мучительную задержку производительности для пользователя (мы только что перешли на Windows 10 / Excel 2016 на этой неделе из-за Windows 7 EOL) Мне интересно, возможно, я что-то упустил что-то новое в VBA / Excel это может вызвать такую ​​задержку или если код нуждается в некоторой очистке. Примечание: я не писал этот код, но мне поручено его исправить.

Код вызывает пользовательскую форму VBA, которую пользователь может напечатать, скопировать и вставить до 16 различных полей (как показано ниже). Как только они нажимают кнопку добавления, он добавляет запись в список ws. Ничего сложного и теоретически все должно работать мгновенно. Я понятия не имею, почему это так долго. Может кто-нибудь помочь, пожалуйста?

Спасибо!

КОД

Module1

Sub showme()
    frmqcinfo.Show 0
End Sub

форма пользователя frmqcinfo

Private Sub cmdAdd_Click()
    Dim ws As Worksheet
    Dim addme As Range
    Set ws = Sheet1
    Set addme = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)

    If Not IsDate(txtdate.Value) Then
        MsgBox " The date field must be a proper date", vbExclamation, "Date format error"
        Me.txtdate.Value = ""
        Me.txtdate.SetFocus
        Exit Sub
    End If

    If Me.txtqcdte.Value = "" Or Me.cboproc.Value = "" Or Me.txttdk.Value = "" Or         Me.txtsmpsz.Value = "" Then
        MsgBox "There is insufficient data. All fields must be added", vbExclamation, "Mandatory                 fields are incomplete"
        Exit Sub
    End If

    With ws
    'set the date format to suit your area

        addme.Value = Format(txtdate.Value, "mm/dd/yy")
        addme.Offset(0, 1).Value = Me.cboproc.Value
        addme.Offset(0, 2).Value = Format(txtqcdte.Value, "mm/dd/yy")
        addme.Offset(0, 3).Value = Format(txttdk.Value, "00")
        addme.Offset(0, 4).Value = Format(txtsmpsz.Value, "00")
        addme.Offset(0, 5).Value = Format(txttranty.Value, "00")
        addme.Offset(0, 6).Value = Format(txtmissln.Value, "00")
        addme.Offset(0, 7).Value = Format(txtmdate.Value, "00")
        addme.Offset(0, 8).Value = Format(txtcovamt.Value, "00")
        addme.Offset(0, 9).Value = Format(txtwdk.Value, "00")
        addme.Offset(0, 10).Value = Format(txtesc.Value, "00")
        addme.Offset(0, 11).Value = Format(txtcsr.Value, "00")
        addme.Offset(0, 12).Value = Format(txtwrnst.Value, "00")
        addme.Offset(0, 13).Value = Format(txtcarrier.Value, "00")
        addme.Offset(0, 14).Value = Format(txtpolnum.Value, "00")
        addme.Offset(0, 15).Value = Format(txtfldzn.Value, "00")
        addme.Offset(0, 16).Value = Format(txtodd.Value, "00")
        addme.Offset(0, 17).Value = Format(txtoth.Value, "00")

    End With
    Sheet4.Select
'reset the form
    Unload Me
    frmqcinfo.Show 0
'update the sheet
    Application.ScreenUpdating = True

End Sub

Answer 1

Попробуйте отключить вычисления: Application.Calculation = xlManual. Затем включите его снова в конце: Application.Calculation = xlAutomatic