Очень медленное выполнение кодов Excel 2016 VBA

Question

У меня случай медленного выполнения кода VBA. Мне трудно в это поверить, потому что у меня четырехъядерный процессор Core i7, работающий на частоте 2,6 ГГц.

В моей рабочей тетради на отдельном листе есть форма ввода для ввода счетов в базу данных (лист "frmBienNhan"). Затем на другом листе я суммирую все введенные счета с помощью сводной таблицы (лист "rpt_LSGD"). Я использую событие BeforeDoubleClick на листе "rpt_LSGD", чтобы вывести пользователей на разные листы в зависимости от того, где они нажимают, чтобы упростить навигацию. Все коды работают нормально, но коды, связанные с пользовательской формой, работают очень медленно. Для их полного исполнения потребовалось около 8-10 секунд.

Я только начинающий с Excel VBA, я был бы очень признателен за любую помощь.

Следующий код перехватывает, когда пользователь дважды щелкает по листу и показывает их на соответствующем листе. Часть этого кода работает очень медленно.

    Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
        Dim a As String, b As Range

        Application.ScreenUpdating = False

        If ActiveCell.row > 4 Then
            Select Case ActiveCell.Column
                Case Is = 4 'This column contain invoice number
                    'Take the user to Invoice input form to edit the invoice they just double-clicked on
                    a = ActiveCell.Value
                    With Sheets("frmBienNhan")
                        .Unprotect Password:="forsce15"
                        .Range("K9").Value = a
                        .Protect Password:="forsce15"
                    End With
                    Call layThTinBienNhan 'This sub entered all invoice data previously entered into the user form
                    Sheets("frmBienNhan").Select
'The code from this point forward run very quickly
                Case Is = 9
                    Select Case ActiveCell.Offset(0, 1).Value
                        Case Is = 0
                            'Copy ma bien nhan sang sheet phan cong nhiem vu
                            a = ActiveCell.Offset(0, -5).Value
                            Sheets("frmPhanCongNhVu").Range("L6").Value = a
                            'Xoa form phan cong nhiem vu
                            Sheets("frmPhanCongNhVu").Range("N13:S32").ClearContents
                            'Chuyen sang form phan cong nhiem vu
                            Sheets("frmPhanCongNhVu").Select
                        Case Is <> 0
                            'Copy ma bien nhan sang sheet phan cong nhiem vu
                            a = ActiveCell.Offset(0, -5).Value
                            Sheets("frmPhanCongNhVu").Range("L6").Value = a

                            'Xoa form phan cong nhiem vu
                            Sheets("frmPhanCongNhVu").Range("N13:S32").ClearContents

                            'Kiem tra xem bien nhan hien tai da duoc phan cong hay chua
                            If Sheets("frmPhanCongNhVu").Range("I13").Value = "N/A" Then
                                'Neu chua phan cong thi chuyen sang sheet phan cong
                                Sheets("frmPhanCongNhVu").Select
                            Else
                                'Neu da phan cong thi nhap du lieu cu vao form phan cong
                                For Each b In Sheets("frmPhanCongNhVu").Range("T13:T32")
                                    If b.Value <> "N/A" Then
                                        b.Offset(0, -6).Value = b.Offset(0, 0).Value 'TaiLieu
                                        b.Offset(0, -5).Value = b.Offset(0, 1).Value 'LoaiCongViec
                                        b.Offset(0, -6).Value = b.Offset(0, 2).Value 'NgThucHien
                                        b.Offset(0, -3).Value = b.Offset(0, 3).Value 'TrangTG
                                        b.Offset(0, -2).Value = b.Offset(0, 4).Value 'TrangVDM
                                        b.Offset(0, -1).Value = b.Offset(0, 5).Value 'NgayGiaoViec
                                    End If
                                Next b
                                'Chuyen sang form phan cong
                                Sheets("frmPhanCongNhVu").Select
                            End If
                    End Select
            End Select
        End If

        Application.ScreenUpdating = True
    End Sub

Следующий код обновляет пользовательскую форму старыми данными счета, чтобы они могли редактировать этот счет. Этот код работает очень медленно.

Sub layThTinBienNhan()
    Dim r As Range
    Dim ws As Worksheet

    Application.ScreenUpdating = False

'Clear form
    Set ws = Sheets("frmBienNhan")
    For Each r In ws.Range("C6:K36")
        If r.Locked = False Then
            r.Value = vbNullString
        End If
    Next r

'Copy old data to user form
    With ws
        .Range("D6").Value = .Range("L11").Value 'Khach hang
        .Range("D7").Value = .Range("M11").Value 'So DT
        .Range("D9").Value = .Range("Q6").Value 'Ghi chu
        .Range("I9").Value = .Range("Q9").Value 'Thanh toan
        .Range("D34").Value = .Range("N9").Value 'Gio giao
        .Range("D35").Value = .Range("O9").Value 'Ngay giao
        .Range("D36").Value = .Range("M9").Value 'Ngay nhan
    End With
    For Each r In ws.Range("L13:L32")
        If r.Value <> "N/A" Then
            With r
                .Offset(0, -9).Value = .Offset(0, 2).Value 'Ten ho so
                .Offset(0, -8).Value = .Offset(0, 3).Value 'Ngon ngu
                .Offset(0, -7).Value = .Offset(0, 4).Value 'Trang dich
                .Offset(0, -6).Value = .Offset(0, 5).Value 'Don gia dich
                .Offset(0, -5).Value = .Offset(0, 6).Value 'So luong nhan ban
            End With
        End If
    Next r

    Application.ScreenUpdating = True
End Sub

Этот код используется для обновления данных счета. Этот код работает немного медленно.

Sub capnhatBienNhan()
    Dim a As Range
    Dim r As Long

    Application.ScreenUpdating = False
    Sheets("frmBienNhan").Unprotect Password:="forsce15"

    r = Sheets("frmBienNhan").Range("R9").Value

'Update invoice info
    With Sheets("datLSGD")
        .Cells(r, 4).Value = Sheets("frmBienNhan").Range("T2").Value 'MaQLy
        .Cells(r, 5).Value = Sheets("frmBienNhan").Range("U2").Value 'NgayGD
        .Cells(r, 6).Value = Sheets("frmBienNhan").Range("V2").Value 'GioGiao
        .Cells(r, 7).Value = Sheets("frmBienNhan").Range("W2").Value 'NgayGiao
        .Cells(r, 8).Value = Sheets("frmBienNhan").Range("X2").Value 'Ghichu
        .Cells(r, 9).Value = Sheets("frmBienNhan").Range("Y2").Value 'ThanhToan
    End With

'Update invoice items info
    On Error Resume Next
    For Each a In Sheets("frmBienNhan").Range("L13:L32")
        If a <> "N/A" Then
            r = a.Value
            With Sheets("datChiTietBN")
                .Cells(r, 2).Value = a.Offset(0, -11).Value 'MaBNEntry
                .Cells(r, 3).Value = a.Offset(0, -9).Value 'TenHoSo
                .Cells(r, 4).Value = a.Offset(0, -8).Value 'NgonNgu
                .Cells(r, 5).Value = a.Offset(0, -7).Value 'SLDich
                .Cells(r, 6).Value = a.Offset(0, -6).Value 'DonGiaDich
                .Cells(r, 7).Value = a.Offset(0, -5).Value 'SLBanSao
                .Cells(r, 8).Value = a.Offset(0, -4).Value 'DonGiaBanSao
                .Cells(r, 9).Value = a.Offset(0, -3).Value 'SLCongChung
                .Cells(r, 10).Value = a.Offset(0, -2).Value 'TienCongChung
            End With
        End If
    Next a
    a = MsgBox("Cap nhat thanh cong", vbOKOnly, "Cap nhat du lieu bien nhan")

    Sheets("frmBienNhan").Protect Password:="forsce15"
    Application.ScreenUpdating = True
End Sub

Следующий код запускается, когда пользователь нажимает кнопку "Обновить" в пользовательской форме. Он проверит, создает ли пользователь новый счет или обновляет существующий, и предпринимает соответствующие действия. Этот код работает довольно медленно.

Sub nhapBienNhan()
Dim lastRow As Long
Dim a As Range

Application.ScreenUpdating = False

'Unlock sheet
Sheets("frmBienNhan").Unprotect Password:="forsce15"

If Sheets("frmBienNhan").Range("H1").Value <> 0 Then
    MsgBox "Cac o co tieu de mau do khong duoc de trong."
    Exit Sub

ElseIf Sheets("frmBienNhan").Range("K9").Value <> vbNullString Then
    Call capnhatBienNhan

Else
    'creating new invoice items data
    For Each a In Sheets("frmBienNhan").Range("C13:C32")
        If a.Value <> vbNullString Then
            lastRow = Sheets("frmBienNhan").Range("Q2").Value
            With Sheets("datChiTietBN")
                .Cells(lastRow, 2).Value = a.Offset(0, -2).Value 'MaBNEntry
                .Cells(lastRow, 3).Value = a.Offset(0, 0).Value 'TenHoSo
                .Cells(lastRow, 4).Value = a.Offset(0, 1).Value 'NgonNgu
                .Cells(lastRow, 5).Value = a.Offset(0, 2).Value 'SLDich
                .Cells(lastRow, 6).Value = a.Offset(0, 3).Value 'DonGiaDich
                .Cells(lastRow, 7).Value = a.Offset(0, 4).Value 'SLBanSao
                .Cells(lastRow, 8).Value = a.Offset(0, 5).Value 'DonGiaBanSao
                .Cells(lastRow, 9).Value = a.Offset(0, 6).Value 'SLCongChung
                .Cells(lastRow, 10).Value = a.Offset(0, 7).Value 'TienCongChung
            End With
        End If
    Next a

    'Creating new invoice data
    lastRow = Sheets("frmBienNhan").Range("R2").Value
    With Sheets("datLSGD")
        .Cells(lastRow, 2).Value = Sheets("frmBienNhan").Range("Q4").Value 'TinhTrangBN
        .Cells(lastRow, 3).Value = Sheets("frmBienNhan").Range("S2").Value 'MaBN
        .Cells(lastRow, 4).Value = Sheets("frmBienNhan").Range("T2").Value 'MaKhachHang
        .Cells(lastRow, 5).Value = Sheets("frmBienNhan").Range("U2").Value 'NgayGD
        .Cells(lastRow, 6).Value = Sheets("frmBienNhan").Range("V2").Value 'GioGD
        .Cells(lastRow, 7).Value = Sheets("frmBienNhan").Range("W2").Value 'NgayGiao
        .Cells(lastRow, 8).Value = Sheets("frmBienNhan").Range("X2").Value 'GhiChu
        .Cells(lastRow, 9).Value = Sheets("frmBienNhan").Range("Y2").Value 'ThanhToan
    End With

    Sheets("frmbiennhan").Range("K9").Value = Sheets("frmBienNhan").Range("S2").Value

    MsgBox "Da luu bien nhan", vbOKOnly, "Nhap bien nhan moi"

    'Lock sheet
    ActiveSheet.Protect Password:="forsce15"
End If

Application.ScreenUpdating = True
End Sub

Спасибо вам, ребята, за ваше время и усилия. Дайте мне знать, если вам нужно больше разъяснений или образцов.

score 0 · Accepted Answer · 2011-03-09T19:38:42

Проблема в том, что у вас есть циклы со многими итерациями из-за большого диапазона.

VBA просто не работает, когда вы создаете петли, проходящие мимо множества ячеек.

Они есть:

For Each a In Sheets("frmBienNhan").Range("C13:C32")

Вероятно, будет быстрее, если вы не используете .range, а вместо этого делаете простое:

For a = 13 to 32

А также

if cells(12,a) <> vbNullString then

Сейчас выбран русский

Очень медленное выполнение кодов Excel 2016 VBA

1 ответ1

Всё ещё ищете ответ? Посмотрите другие вопросы с метками performance vba microsoft-excel-2016.

Очень медленное выполнение кодов Excel 2016 VBA

1 ответ1

Всё ещё ищете ответ? Посмотрите другие вопросы с метками performance vba microsoft-excel-2016.

Похожие