Tối ưu thời gian chạy cho đoạn code

moihocvba · 26/12/20

Xin chào cả nhà, em đang viết phiếu bán hàng, lưu hóa đơn và bước cuối cùng là xóa trắng hóa đơn về trạng thái ban đầu, sau đây là code xóa trắng về trạng thái ban đầu:

Mã:

Sub ResetTrangThai()
Dim t As Single
t = Timer
Application.EnableEvents = False
Application.ScreenUpdating = False
    With Sheets("LapPhieu")
        .Range("AE3").Value = 1 ' quay lai loai phieu Ban Hang
        .Range("B21:S200,AA5:AS5,AE1,I3:k6,AE1").ClearContents  ' xoa trang du lieu
        .Range("b4").Value = Now ' cap nhat lai thoi gian la hien tại
    End With
    Sheets("ShList").Range("AH3").ClearContents  '
Application.ScreenUpdating = True
Application.EnableEvents = True
MsgBox Timer - t
End Sub

Vấn đề là chỉ riêng bước này đã ngốn mất thời gian là 0,8 giây, một thời gian khá lâu trong một thao tác gồm rất nhiều bước.

Cả nhà cho em hỏi thời gian để sử lý code trên là 0.8 giây là bình thường hay là lâu ạ, nếu là lâu thì là do máy em hay là do em viết code ko hay chỗ nào, có cách nào tối ưu cho nó chạy nhanh hơn ko, mong cả nhà giúp em với ạ!

Em cảm ơn cả nhà!

Cu Tồ · 26/12/20

moihocvba đã viết:
Xin chào cả nhà, em đang viết phiếu bán hàng, lưu hóa đơn và bước cuối cùng là xóa trắng hóa đơn về trạng thái ban đầu, sau đây là code xóa trắng về trạng thái ban đầu:

Mã:

Sub ResetTrangThai() Dim t As Single t = Timer Application.EnableEvents = False Application.ScreenUpdating = False With Sheets("LapPhieu") .Range("AE3").Value = 1 ' quay lai loai phieu Ban Hang .Range("B21:S200,AA5:AS5,AE1,I3:k6,AE1").ClearContents ' xoa trang du lieu .Range("b4").Value = Now ' cap nhat lai thoi gian la hien tại End With Sheets("ShList").Range("AH3").ClearContents ' Application.ScreenUpdating = True Application.EnableEvents = True MsgBox Timer - t End Sub

View attachment 251911

Vấn đề là chỉ riêng bước này đã ngốn mất thời gian là 0,8 giây, một thời gian khá lâu trong một thao tác gồm rất nhiều bước.

Cả nhà cho em hỏi thời gian để sử lý code trên là 0.8 giây là bình thường hay là lâu ạ, nếu là lâu thì là do máy em hay là do em viết code ko hay chỗ nào, có cách nào tối ưu cho nó chạy nhanh hơn ko, mong cả nhà giúp em với ạ!

Em cảm ơn cả nhà!

Không biết + thêm các công đoạn khác thì thời gian tăng lên như thế nào nhưng 0,8s thì cũng đâu tới nối,nếu các ô xóa có liên quan đến công thức trong bảng tính thì thêm dòng lệnh tạm dừng tính toàn đi sau đó trả về

VuVanHao · 26/12/20

@moihocvba Thử code của bạn trên máy mình thấy cũng nhanh mà

Cu Tồ · 26/12/20

hao93tbdtn đã viết:
@moihocvba Thử code của bạn trên máy mình thấy cũng nhanh màView attachment 251912

Cộng thêm dữ liệu trên bảng tính nữa thì cũng đâu đó tầm 0,4 0,6s

vu_tuan_manh_linh · 26/12/20

Thử thêm cái Application.Calcaulation = xlCalculationManual xem có hơn không, vì khi xóa dữ liệu đồng nghĩa với việc các hàm có tham chiếu đến vùng dữ liệu bị xóa sẽ chạy.
Cái đoạn Application.EnableEvents = False chỉ nên dùng nếu trong sheet của bạn có đặt các thủ tục worksheet_change() hoặc worksheetselection_change()

Maika8008 · 26/12/20

Chỉ tốn có chừng này thôi mà

VuVanHao · 26/12/20

Cu Tồ đã viết:
Cộng thêm dữ liệu trên bảng tính nữa thì cũng đâu đó tầm 0,4 0,6s

Vâng, với việc máy chip celeron G3930 của em thì các ưu tiên cho nó bon là:
- Xây bảng dữ liệu chuẩn cho dễ code và tham khảo các code trên diễn đàn
- Hạn chế tối đa việc màu mè, bôi son phấn.
Chốt cái là 0.8 hay 1-2s cũng như cái chớp mắt thôi, nên không bận tâm lắm

Nhattanktnn · 26/12/20

Maika8008 đã viết:
Chỉ tốn có chừng này thôi mà
View attachment 251913

Không có file đính kèm thì nó nhanh rồi bác, nhưng giả sử Range("AE3")=1 mà cái ô này nó có nhiều ô link tới nó, thì code sẽ phải tính cả thời gian chờ công thức những ô khác chạy, do đó có thể trên file của bạn ấy 0.8 mà mình không test được

HeSanbi · 26/12/20

@moihocvba
Chắc là file có nhiều công thức tham chiếu đến ô đang xóa

Thêm đoạn chuyển chế độ tính toán bằng tay trước khi xóa và tự động sau khi xóa.

Application.Calculation = xlCalculationManual
...
Application.Calculation = xlAutomatic

Dưới đây là một đoạn code nâng cao để tăng tốc cho một đoạn code.

Chỉ cần gọi thủ tục SetAsyncCallbackToFinish ở đầu thủ tục cần chạy, không cần phải
lặp lại Application.ScreenUpdating = True, Application.EnableEvents = True

JavaScript:

Sub ResetTrangThai()
  SetAsyncCallbackToFinish
  '..........................
End Sub

JavaScript:

Public Const OTAsyncCallackToFinish = "AsyncCallackToFinish"
Public AsyncCallbackToFinishEnable As Boolean, TimeOutAsyncCallback As Date

Public Sub SetAsyncCallbackToFinish()
  AsyncCallbackToFinishEnable = True
  Call AsyncCallbackToFinish
End Sub
Public Sub AsyncCallbackToFinish()
  If AsyncCallbackToFinishEnable Then
    On Error Resume Next
    AOT2 TimeOutAsyncCallback, OTAsyncCallackToFinish, False
    SetSpeedApp True
    TimeOutAsyncCallback = VBA.Now()
    AOT2 TimeOutAsyncCallback, OTAsyncCallackToFinish, True
    AsyncCallbackToFinishEnable = False
    On Error GoTo 0
  Else
    Call SetSpeedApp: TimeOutAsyncCallback = 0
  End If
End Sub

Public Sub SetSpeedApp(Optional ByVal IsOn As Boolean = False)
  On Error Resume Next
  With Application
    If IsOn Then
      If .ScreenUpdating Then .ScreenUpdating = False
      If .Calculation <> xlCalculationManual Then .Calculation = xlCalculationManual
      If .EnableEvents Then .EnableEvents = False
    Else
      If .Calculation <> xlAutomatic Then .Calculation = xlAutomatic
      If Not .ScreenUpdating Then .ScreenUpdating = True
      If Not .EnableEvents Then .EnableEvents = True
    End If
  End With
  On Error GoTo 0
End Sub

Sub AOT2(time As Date, Proc$, Optional ByVal Schedule As Boolean = True)
  On Error Resume Next
  Application.OnTime time, "'" & ThisWorkbook.Name & "'!" & Proc, , Schedule
  If Not Schedule Then time = 0
  On Error GoTo 0
End Sub

befaint · 26/12/20

Còn phải xem có bao nhiêu sự kiện của worksheet, workbook kéo theo nữa.

moihocvba · 27/12/20

vu_tuan_manh_linh đã viết:
Thử thêm cái Application.Calcaulation = xlCalculationManual xem có hơn không, vì khi xóa dữ liệu đồng nghĩa với việc các hàm có tham chiếu đến vùng dữ liệu bị xóa sẽ chạy.
Cái đoạn Application.EnableEvents = False chỉ nên dùng nếu trong sheet của bạn có đặt các thủ tục worksheet_change() hoặc worksheetselection_change()

Đúng là em thêm đoạn đó vào nó chỉ tốn có 0.2 giây, cám ơn annh nhiều nhé!

Bài đã được tự động gộp: 27/12/20

HeSanbi đã viết:
@moihocvba
Chắc là file có nhiều công thức tham chiếu đến ô đang xóa

Thêm đoạn chuyển chế độ tính toán bằng tay trước khi xóa và tự động sau khi xóa.

Application.Calculation = xlCalculationManual
...
Application.Calculation = xlAutomatic

Dưới đây là một đoạn code nâng cao để tăng tốc cho một đoạn code.

Chỉ cần gọi thủ tục SetAsyncCallbackToFinish ở đầu thủ tục cần chạy, không cần phải
lặp lại Application.ScreenUpdating = True, Application.EnableEvents = True

JavaScript:

Sub ResetTrangThai() SetAsyncCallbackToFinish '.......................... End Sub

JavaScript:

Public Const OTAsyncCallackToFinish = "AsyncCallackToFinish" Public AsyncCallbackToFinishEnable As Boolean, TimeOutAsyncCallback As Date Public Sub SetAsyncCallbackToFinish() AsyncCallbackToFinishEnable = True Call AsyncCallbackToFinish End Sub Public Sub AsyncCallbackToFinish() If AsyncCallbackToFinishEnable Then On Error Resume Next AOT2 TimeOutAsyncCallback, OTAsyncCallackToFinish, False SetSpeedApp True TimeOutAsyncCallback = VBA.Now() AOT2 TimeOutAsyncCallback, OTAsyncCallackToFinish, True AsyncCallbackToFinishEnable = False On Error GoTo 0 Else Call SetSpeedApp: TimeOutAsyncCallback = 0 End If End Sub Public Sub SetSpeedApp(Optional ByVal IsOn As Boolean = False) On Error Resume Next With Application If IsOn Then If .ScreenUpdating Then .ScreenUpdating = False If .Calculation <> xlCalculationManual Then .Calculation = xlCalculationManual If .EnableEvents Then .EnableEvents = False Else If .Calculation <> xlAutomatic Then .Calculation = xlAutomatic If Not .ScreenUpdating Then .ScreenUpdating = True If Not .EnableEvents Then .EnableEvents = True End If End With On Error GoTo 0 End Sub Sub AOT2(time As Date, Proc$, Optional ByVal Schedule As Boolean = True) On Error Resume Next Application.OnTime time, "'" & ThisWorkbook.Name & "'!" & Proc, , Schedule If Not Schedule Then time = 0 On Error GoTo 0 End Sub

Cám ơn anh nhiều nhé, để em thử xem!

Tối ưu thời gian chạy cho đoạn code

moihocvba

Thành viên thường trực

Cu Tồ

Tìm đến kiến thức! ꧁༺ Cu Tồ ༻꧂

VuVanHao

Thành viên thường trực

Cu Tồ

Tìm đến kiến thức! ꧁༺ Cu Tồ ༻꧂

vu_tuan_manh_linh

linhvtm84@gmail.com

Maika8008

Thành viên gạo cội

VuVanHao

Thành viên thường trực

Nhattanktnn

Thành viên gắn bó

HeSanbi

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

befaint

|||||||||||||

moihocvba

Thành viên thường trực

Bài viết mới nhất

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng