Estou tendo um caso de execução lenta de código vba. Acho difícil acreditar, porque tenho um processador Core i7 quad-core operando a 2,6 GHz.
Em minha pasta de trabalho, tenho um formulário de entrada em uma folha separada para inserir faturas no banco de dados (folha "frmBienNhan"). Em seguida, em outra folha eu resumir todas as faturas inseridas com um pivotable (folha "rpt_LSGD"). Eu uso o evento BeforeDoubleClick na planilha "rpt_LSGD" para trazer o usuário para diferentes planilhas dependendo de onde eles clicam para facilitar a navegação. Todos os códigos são executados corretamente, mas os códigos relacionados ao formulário do usuário são extremamente lentos. Demorou cerca de 8 a 10 segundos para serem totalmente executados.
Eu sou apenas um iniciante no Excel VBA. Eu apreciaria muito qualquer ajuda.
O código a seguir intercepta onde o usuário clica duas vezes na planilha e mostra a planilha correspondente. Parte deste código é executada muito lentamente.
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
O código a seguir atualiza o formulário do usuário com dados antigos da fatura para que eles possam editar a fatura. Esse código é executado muito devagar.
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
Este código é usado para atualizar os dados da fatura. Este código é um pouco lento.
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
O código a seguir é executado quando o usuário clica no botão "Atualizar" no formulário do usuário. Ele verificará se o usuário está criando uma nova fatura ou atualizando uma existente e executando a ação correspondente. Esse código é muito lento.
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
Obrigado por seu tempo e esforço. Deixe-me saber se você precisa de mais esclarecimentos ou amostras.
O problema é que você tem loops com muitas iterações devido a um grande intervalo.
O VBA não é rápido quando você cria loops que passam por muitas células.
Eles são:
For Each a In Sheets("frmBienNhan").Range("C13:C32")
É provável que seja mais rápido se você não usar o .range, mas faça um simples:
For a = 13 to 32
e
if cells(12,a) <> vbNullString then