การเรียกใช้โค้ด Excel 2016 VBA ช้ามาก

ฉันมีกรณีของการเรียกใช้โค้ด vba ที่ช้า ฉันคิดว่ามันยากที่จะเชื่อเพราะฉันมีหน่วยประมวลผล Quad-core Core i7 ที่ทำงานที่ 2.6 GHz

ในสมุดงานของฉันฉันมีแบบฟอร์มการป้อนข้อมูลในแผ่นงานแยกต่างหากเพื่อป้อนใบแจ้งหนี้ลงในฐานข้อมูล (แผ่นงาน "frmBienNhan") จากนั้นในแผ่นงานอีกแผ่นฉันสรุปใบแจ้งหนี้ที่ป้อนทั้งหมดด้วยแบบ pivotable (แผ่น "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

ขอบคุณสำหรับเวลาและความพยายามของคุณ แจ้งให้เราทราบหากคุณต้องการคำชี้แจงหรือตัวอย่างเพิ่มเติม

ปัญหาคือคุณมีลูปที่มีการวนซ้ำหลายครั้งเนื่องจากช่วงใหญ่

VBA ไม่เร็วเมื่อคุณสร้างลูปที่เดินผ่านเซลล์จำนวนมาก

พวกเขาคือ:

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

มีแนวโน้มว่าจะเร็วขึ้นหากคุณไม่ได้ใช้. orange แต่ทำแบบง่าย ๆ แทน:

For a = 13 to 32

และ

if cells(12,a) <> vbNullString then