我遇到了 vba 代码执行缓慢的情况。我觉得难以置信,因为我有一个运行速度为 2.6 GHz 的四核 Core i7 处理器。
在我的工作簿中,我在单独的工作表上有一个输入表单,用于将发票输入数据库(工作表“frmBienNhan”)。然后在另一张工作表上,我用一个可透视表(工作表“rpt_LSGD”)汇总所有输入的发票。我使用工作表“rpt_LSGD”中的 BeforeDoubleClick 事件将用户带到不同的工作表,具体取决于他们单击的位置,以方便导航。所有代码运行良好,但与用户表单相关的代码运行速度极慢。它们完全执行大约需要 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
感谢你们付出的时间和精力。如果您需要更多说明或样本,请告诉我。
答案1
问题是由于范围太大,导致循环迭代次数过多。
当您创建遍历大量单元格的循环时,VBA 的速度并不快。
他们是:
For Each a In Sheets("frmBienNhan").Range("C13:C32")
如果您不使用 .range 而是执行简单的操作,则可能会更快:
For a = 13 to 32
和
if cells(12,a) <> vbNullString then