Macro code VBA bị chậm

Mọi người xem giúp đoạn code của mình có vấn đề gì không mà khi chạy rất chậm.
Vấn đề mình gặp phải là giữa label thời gian chạy hiện tại trên userform và khi chạy lệnh countdown time ( set nút commandbutton3 ) rất chậm khi sử dụng các tác vụ nút nhấm label text khác trên userform1.
và hiện thì dòng text chạy của mình củng bị gán theo số giây thời gian nên không nhanh mượt được.
Nút lệnh export dữ liệu của mình củng bị vấn đề tắt form khi close!
mong mn giúp đỡ ạ

Private Sub CommandButton1_Click()
UserForm1.Label5.Caption = Label5.Caption + 1
Label6 = Label4.Caption - Label5.Caption

If UserForm1.Label4.Caption <> 0 Then
Label10 = ((Label5.Caption / Label4.Caption) * 100) & "%"
Else
End If
End Sub

Private Sub CommandButton2_Click()
UserForm1.Label5.Caption = Label5.Caption - 1
Label6 = Label4.Caption - Label5.Caption
If UserForm1.Label4.Caption <> 0 Then
Label10 = ((Label5.Caption / Label4.Caption) * 100) & "%"


Else
End If
End Sub

Private Sub CommandButton5_Click()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("report")
Dim lr As Long
lr = Application.WorksheetFunction.CountA(sh.Range("A:A"))

 
sh.Range("A" & lr + 1).Value = "=ROW()-1"
sh.Range("B" & lr + 1).Value = Me.Label4.Caption
sh.Range("C" & lr + 1).Value = Me.Label5.Caption
sh.Range("D" & lr + 1).Value = Me.Label6.Caption
sh.Range("E" & lr + 1).Value = Me.Label10.Caption
sh.Range("F" & lr + 1).Value = Me.Label1.Caption
sh.Range("G" & lr + 1).Value = Me.Label3.Caption


MsgBox "Data added successfully", vbInformation
sh.Range("A1").Value = "Nber"
sh.Range("B1").Value = "Target"
sh.Range("C1").Value = "Actual"
sh.Range("D1").Value = "Difer"
sh.Range("E1").Value = "RFT"
sh.Range("F1").Value = "AtTime"
sh.Range("G1").Value = "Date"

End Sub

''''export
Private Sub CommandButton4_Click()
  Dim nwb As Workbook
    Set nwb = Workbooks.Add
    ThisWorkbook.Sheets("report").UsedRange.Copy nwb.Sheets(1).Range("A1")
 End Sub

'''Time running
'Dim Berhenti As Boolean
Private Sub Userform_Activate()
Do Until Berhenti
Label1.Caption = Time
Label3.Caption = WorksheetFunction.Text(Date, "[$-0421]DDDD, DD MMMM YYYY")
Label19.Left = Label19.Left - 2
If Label19.Left <= 0 - Label19.Width Then Label19.Left = Me.Width
For i = 1 To 8000000: Next
DoEvents
Loop
End Sub
Private Sub userform_Initialize()
BackColor = RGB(58, 68, 156)
End Sub
Private Sub Userform_QueryClose(cancel As Integer, CloseMode As Integer)
Berhenti = True
End Sub



Private Sub Label4_Click()
UserForm1.Label4.Caption = TextBox1.Text
End Sub

Private Sub TextBox1_Change()
On Error Resume Next
Label4 = TextBox1.Text
Label6 = Label4.Caption - Label5.Caption
Label10 = ((Label5.Caption / Label4.Caption) * 100) & "%"
End Sub

Private Sub CommandButton3_Click()
Run_time
End Sub

**''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' code in module:**
'''Count down
Sub Run_time()
'Application.ScreenUpdating = False
a = UserForm1.TextBox2.Value
b = UserForm1.TextBox3.Value
C = UserForm1.TextBox4.Value
d = UserForm1.TextBox5.Value
e = UserForm1.TextBox6.Value
f = UserForm1.TextBox7.Value
n = a * 10 * 60 * 60 + b * 60 * 60 + C * 10 * 60 + d * 60 + e * 10 + f
'Unload Me
UserForm1.Show
UserForm1.Label13.Caption = a & b & ":" & C & d & ":" & e & f
For i = 1 To n
UserForm1.Label1.Caption = Time
Application.Wait (Now + #12:00:01 AM#)
UserForm1.Label3.Caption = WorksheetFunction.Text(Date, "[$-0421]DDDD, DD MMMM YYYY")
'''''cuoi

DoEvents
UserForm1.Label19.Left = UserForm1.Label19.Left - 2
If UserForm1.Label19.Left <= 0 - UserForm1.Label19.Width Then UserForm1.Label19.Left = UserForm1.Label19.Width
For J = 1 To 8000000: Next
UserForm1.Label13.Caption = Format(DateAdd("s", -1, UserForm1.Label13.Caption), " hh:mm:ss")
UserForm1.Label15.Width = 156 - 156 * i / n
    'Beep
Next i
End Sub

Bạn format lại code chứ để vậy sao mà đọc được.
Mấy dòng lặp tới 8 triệu lần như For J = 1 To 8000000: NextFor i = 1 To 8000000: Next để làm gì vậy? 8 tr * 8 tr là lặp biết bao nhiêu lần rồi :roll_eyes:

4 Likes

đoạn code đó mình chạy cho running text bạn ạ, nhưng mình thấy đang bị vấn đề với lệnh application.wait …do lệnh này mà chậm form. Với chỗ bị gán chữ chạy với số giây đếm…ko chạy nhanh chữ được

83% thành viên diễn đàn không hỏi bài tập, còn bạn thì sao?