Em có sử dụng code thông báo nếu phát hiện dữ liệu có vấn đề. Ngày trước em dùng Msgbox nhưng khi file mở khoảng tầm 1 tiếng, lúc chạy nếu có thông báo thì rất chậm (kiểu như file bị đơ mất 1 2 phút). Sau đó em quay sang sử dụng UserForm để thông báo thì cũng bị tình trạng tương tự. (Lúc đầu thì rất nhanh, sau càng dùng càng chậm). Không biết lý do là gì có ai gặp như em không?
Lỗi lạ xử lý chậm Msgbox hoặc hiện Form thông báo
- Thread starter tueyennhi
- Ngày gửi
Máy mình ram 4G, để lâu thấy dung lượng tiêu tốn cho excel từ 200 lên 250 thì mình nghĩ nó không tăng bao nhiêu. Khó hiểu. Các object thì đều giải phóng hết ở cuối mỗi Module lệnh.
Upvote
0
Code em đang dùng đây anh:
PHP:
Option Explicit
#If VBA7 And Win64 Then 'Office 64-bit
Declare PtrSafe Function GetTickCount Lib "kernel32" Alias "GetTickCount64" () As LongLong
#Else ' Office 32-bit
Declare Function GetTickCount Lib "kernel32" () As Long
#End If
Public ofn As WorksheetFunction
Public T6 As Single, T7 As Single, T8 As Single, T9 As Single, T10 As Single, T14 As Single, T15 As Single, T17 As Single, T18 As Single, T20 As Single, T21 As Single, T22 As Single, T23 As Single, T24 As Single, T30 As Single, T31 As Single, T32 As Single, T33 As Single, T46 As Single, T48 As Single
Public Rws As Long, R As Long, i As Long, j As Long, k As Long
Public oldScrUp As Boolean, oldEvt As Boolean, oldCalc As Long
Public Sh_HienHanh As Worksheet, Sh_Form As Worksheet, Sh_Check As Worksheet, Sh_BCC As Worksheet, Sh_TongHop As Worksheet, Sh_MAIN As Worksheet, Sh_EXTRA As Worksheet
Private Sub My_baby()
Dim Arr As Variant, sArr As Variant, Tem As Variant, mangDL()
Dim Ca As String, NgayCong As String
Dim Dic As Object, Dic_bp As Object, Rng As Range
Dim S1 As Byte, maxRow As Long, maxCol As Long, max As Long
Dim Vao As Single, Ra As Single, Vao2 As Single, Ra2 As Single, CL As Single, t As Single
Dim Ngay As Date
Call OffFunction
Set Sh_HienHanh = Application.ThisWorkbook.ActiveSheet
Set Sh_Form = Application.ThisWorkbook.Sheets("Form")
Set Sh_Check = Application.ThisWorkbook.Sheets("Check")
Set ofn = Application.WorksheetFunction
NgayCong = Trim(Sh_HienHanh.Range("A1").Value)
Sh_HienHanh.Range("D3") = Sh_HienHanh.Range("B10").Value
'Make code attendance upload
If Len(NgayCong) = 0 Then
Range("AA3").Resize(1, 5) = Array(30, 31, 32, 34, 35)
ElseIf NgayCong Like "CN" Then
Range("AA3").Resize(1, 5) = Array(0, 0, 40, 36, 0)
ElseIf NgayCong Like "LT" Then
Range("AA3").Resize(1, 5) = Array(0, 0, 37, 38, 0)
End If
'Dieu kien 1
If IsNumeric(Sh_HienHanh.Name) Then
Ngay = Sh_HienHanh.Range("D3")
ReDim Thongbao(0 To 10)
Thongbao(0) = Sh_HienHanh.Name
t = GetTickCount
Sh_HienHanh.Range("A4").ClearContents
'Bo loc...............................................................................................
If Sh_HienHanh.FilterMode Then Sh_HienHanh.ShowAllData
Rws = Range("C65536").End(xlUp).Row - 8
'So nguoi di lam...............................................................................................
Sh_HienHanh.Range("A4") = Rws
Sh_HienHanh.Range("B4").ClearContents
'Format...............................................................................................
Sh_Form.Range("A5").Resize(, 51).Copy
Sh_HienHanh.Range("A9").Resize(Rws, 51).PasteSpecial Paste:=xlPasteFormats
Sh_HienHanh.Range("X9").Resize(Rws, 28).ClearContents
'Range("A9").Resize(Rws, 47).Borders.LineStyle = 1
'Dat bien
T6 = TimeSerial(6, 0, 0): T7 = TimeSerial(7, 0, 0)
T8 = TimeSerial(8, 0, 0): T9 = TimeSerial(9, 0, 0)
T10 = TimeSerial(10, 0, 0): T14 = TimeSerial(14, 0, 0)
T15 = TimeSerial(15, 0, 0): T17 = TimeSerial(17, 0, 0)
T18 = TimeSerial(18, 0, 0): T20 = TimeSerial(20, 0, 0)
T21 = TimeSerial(21, 0, 0): T22 = TimeSerial(22, 0, 0)
T23 = TimeSerial(23, 0, 0): T24 = TimeSerial(24, 0, 0)
T30 = TimeSerial(30, 0, 0): T31 = TimeSerial(31, 0, 0)
T32 = TimeSerial(32, 0, 0): T33 = TimeSerial(33, 0, 0)
'Phat hien trung...............................................................................................
Set Dic = CreateObject("Scripting.Dictionary")
Arr = Sh_HienHanh.Range("C9").Resize(Rws, 7).Value2
ReDim Check_ID(1 To Rws, 1 To 1)
ReDim Check_Time(1 To Rws, 1 To 2)
' gan so lan trung vao Item cua Dic +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++>
'Bat dau check
For j = 1 To UBound(Arr, 1)
If Not IsEmpty(Arr(j, 1)) Then
If Not Dic.exists(CStr(Arr(j, 1))) Then
Dic.Add CStr(Arr(j, 1)), 1
Else:
Dic.Item(CStr(Arr(j, 1))) = Dic.Item(CStr(Arr(j, 1))) + 1
Sh_HienHanh.Range("B4") = Dic.Item(CStr(Arr(j, 1)))
End If
End If
Next j
'gan so lan trung vao Darr +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++>
For j = 1 To UBound(Arr, 1)
If Not IsEmpty(Arr(j, 1)) Then Check_ID(j, 1) = Dic.Item(CStr(Arr(j, 1)))
Next j
Sh_HienHanh.Range("A9").Resize(Rws).Value = Check_ID
'OK
'Cham cong...............................................................................................
Arr = Sh_HienHanh.Range("F9").Resize(Rws, 50).Value2
ReDim Ledem(1 To Rws, 1 To 1)
ReDim Lengay(1 To Rws, 1 To 1)
'Vong lap me 1
For j = 1 To Rws
If Arr(j, 8) = "S" Or Arr(j, 8) = "M7" Then Arr(j, 9) = "HROK"
Arr(j, 10) = 0
Arr(j, 11) = 0
Arr(j, 12) = 0
Ca = Arr(j, 1)
'Dieu kien 2
If Ca <> "" Then
Vao = Arr(j, 3) - Ngay
Ra = Arr(j, 4) - Ngay
Vao = CDate(Format(Vao, "mmm/dd/yyyy hh:mm "))
Ra = CDate(Format(Ra, "mmm/dd/yyyy hh:mm "))
If CStr(Arr(j, 6)) <> "" Then
If CStr(Arr(j, 7)) <> "" Then
If CStr(Arr(j, 8)) <> "" Then
Arr(j, 10) = Arr(j, 6)
Arr(j, 11) = Arr(j, 7)
End If
End If
ElseIf Len(Arr(j, 3)) > 0 And Len(Arr(j, 4)) > 0 Then
Select Case Ca
'Tu 8h den 17h +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++>
Case "H"
If Vao > T6 Then
If Vao <= T8 Then
If Ra < T18 Then
If Ra >= T17 Then
Arr(j, 10) = T8
Arr(j, 11) = T17
End If
End If
End If
End If
'Tu 8h den 20h +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++>
Case "N"
If Vao > T6 Then
If Vao <= T8 Then
If Ra < T21 Then
If Ra >= T20 Then
Arr(j, 10) = T8
Arr(j, 11) = T20
End If
End If
End If
End If
'Tu 20h den 8h +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++>
Case "D"
If Vao > T18 Then
If Vao <= T20 Then
If Ra < T33 Then
If Ra >= T32 Then
Arr(j, 10) = T20
Arr(j, 11) = T32
End If
End If
End If
End If
'Tu 6h den 14h +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++>
Case "X"
If Vao <= T6 Then
If Ra < T15 Then
If Ra >= T14 Then
Arr(j, 10) = T6
Arr(j, 11) = T14
End If
End If
End If
'Tu 14 den 22h +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++>
Case "Y"
If Vao > T10 Then
If Vao <= T14 Then
If Ra < T23 Then
If Ra >= T22 Then
Arr(j, 10) = T14
Arr(j, 11) = T22
End If
End If
End If
End If
'Tu 22h den 6h +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++>
Case "Z"
If Vao > T20 Then
If Vao <= T22 Then
If Ra < T31 Then
If Ra >= T30 Then
Arr(j, 10) = T22
Arr(j, 11) = T30
End If
End If
End If
End If
End Select
End If
'Ket thuc dieu kien 2
'OK
'Dieu kien 3
If NgayCong = "TL" Then
Lengay(j, 1) = ofn.max(ofn.Round((Arr(j, 11) - T30) * 24, 2), 0)
Ledem(j, 1) = ofn.Round((Arr(j, 11) - Arr(j, 10)) * 24, 2) - Lengay(j, 1)
If Arr(j, 10) > T24 Then Arr(j, 10) = T24
Vao2 = Arr(j, 10)
If Arr(j, 11) > T24 Then Arr(j, 11) = T24
Ra2 = Arr(j, 11)
Arr(j, 12) = ofn.Round((Arr(j, 11) - Arr(j, 10)) * 24, 2)
Ledem(j, 1) = Ledem(j, 1) - Arr(j, 12)
Else:
Arr(j, 12) = ofn.Round((Arr(j, 11) - Arr(j, 10)) * 24, 2)
Vao2 = Arr(j, 10)
Ra2 = Arr(j, 11)
'Ket thuc dieu kien 3
End If
'OK
'Com Giua Ca I -II:' +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++>
Tem = ofn.Round((Arr(j, 14) - Arr(j, 13)) * 24, 2)
Arr(j, 15) = IIf(Tem = 0.5, 1, Tem)
Arr(j, 18) = ofn.Round((Arr(j, 17) - Arr(j, 16)) * 24, 2)
'Tong TG Làm Viec Thuc Te +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++>
Arr(j, 19) = Arr(j, 12) - Arr(j, 15)
If Arr(j, 19) >= 10 Then
Arr(j, 19) = Arr(j, 19) - 0.5
End If
Arr(j, 19) = ofn.Round(Arr(j, 19), 2)
'Thoi gian huong che do +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++>
Arr(j, 20) = IIf(Arr(j, 8) = "S", 1, 0)
'Tong TG Làm Viec Duoc Tinh +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++>
If Ca = "H" Or Ca = "N" Then
Arr(j, 21) = Arr(j, 12) - Tem - IIf(Ra2 <= TimeSerial(18, 0, 0), Arr(j, 18), 0)
ElseIf Ca = "D" Then
Arr(j, 21) = Arr(j, 12) + IIf(Tem > 0, 1 - Tem, 0)
Else: Arr(j, 21) = Arr(j, 12)
End If
Arr(j, 21) = ofn.Round(Arr(j, 21), 2)
'Cong Ngay +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++>
If Ca = "H" Then
If Ra2 <= T8 Then
Arr(j, 22) = 0
Else: Arr(j, 22) = (IIf(Ra2 >= T17, T17, Ra2) - IIf(Vao2 <= T8, T8, Vao2)) * 24 - IIf(Tem > 0, 1, 0)
End If
ElseIf Ca = "N" Then
If Ra2 <= T8 Then
Arr(j, 22) = 0
Else: Arr(j, 22) = (IIf(Ra2 >= T17, T17, Ra2) - IIf(Vao2 <= T8, T8, Vao2)) * 24 - IIf(Tem > 0, 1, 0)
End If
ElseIf Ca = "X" Then
If Ra2 <= T6 Then
Arr(j, 22) = 0
Else: Arr(j, 22) = (IIf(Ra2 > T14, T14, Ra2) - IIf(Vao2 <= T6, T6, Vao2)) * 24
End If
ElseIf Ca = "Y" Then
If Ra2 <= T14 Then
Arr(j, 22) = 0
Else: Arr(j, 22) = (IIf(Ra2 > T22, T22, Ra2) - IIf(Vao2 <= T14, T14, Vao2)) * 24
End If
Else: Arr(j, 22) = 0
End If
Arr(j, 22) = ofn.Round(Arr(j, 22), 2)
'Cong dem +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++>
If Ca = "D" Then
If Ra2 <= T22 Then
Arr(j, 23) = 0
Else: Arr(j, 23) = (IIf(Ra2 >= T30, T30, Ra2) - IIf(Vao2 <= T22, T22, Vao2)) * 24
End If
ElseIf Ca = "Z" Then
If Ra2 <= T22 Then
Arr(j, 23) = 0
Else: Arr(j, 23) = (IIf(Ra2 >= T30, T30, Ra2) - IIf(Vao2 <= T22, T22, Vao2)) * 24
End If
Else: Arr(j, 23) = 0
End If
Arr(j, 23) = ofn.Round(Arr(j, 23), 2)
'OVT ngay +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++>
If Ca = "Z" Then
If Vao2 >= T22 Then
Arr(j, 24) = 0
Else: Arr(j, 24) = Arr(j, 21) - Arr(j, 23) - IIf(Ra2 > T30, (Ra2 - T30) * 24, 0)
End If
ElseIf Ca = "D" Then
If Vao2 >= T22 Then
Arr(j, 24) = 0
Else: Arr(j, 24) = Arr(j, 21) - Arr(j, 23) - IIf(Ra2 > T30, (Ra2 - T30) * 24, 0) - IIf(Tem > 0, 1 - Tem, 0)
End If
ElseIf Ra2 <= T22 Then
Arr(j, 24) = Arr(j, 21) - Arr(j, 22)
ElseIf Ra2 > T22 Then
Arr(j, 24) = Arr(j, 21) - Arr(j, 22) - (Ra2 - T22) * 24
End If
Arr(j, 24) = ofn.Round(Arr(j, 24), 2)
'OK
'OVT D1-D2 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++>
If Arr(j, 24) > 0 Then
Arr(j, 25) = Arr(j, 21) - Arr(j, 22) - Arr(j, 23) - Arr(j, 24)
Arr(j, 26) = 0
ElseIf Arr(j, 24) = 0 Then
Arr(j, 25) = 0
Arr(j, 26) = Arr(j, 21) - Arr(j, 22) - Arr(j, 23)
End If
Arr(j, 25) = ofn.Round(Arr(j, 25), 2)
Arr(j, 26) = ofn.Round(Arr(j, 26), 2)
'OK
'Tong OVT +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++>
Arr(j, 27) = Arr(j, 24) + Arr(j, 25) + Arr(j, 26)
'PC mua cao diem +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++>
If Ca = "H" Or Ca = "N" Or Ca = "D" Then
Arr(j, 28) = 1 - IIf(Tem > 0, Tem, 1)
Else: Arr(j, 28) = 0
End If
'OK
'Quy ra cong +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++>
If Arr(j, 22) > 0 Then
Arr(j, 29) = ofn.Round(Arr(j, 22) / 8, 2) & Ca
ElseIf Arr(j, 23) > 0 Then
Arr(j, 29) = ofn.Round(Arr(j, 23) / 8, 2) & Ca
Else: Arr(j, 29) = 0
End If
'OK
'Cong chinh +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++>
If Arr(j, 22) > 0 Then
Arr(j, 30) = ofn.Round(Arr(j, 22) / 8, 2)
If Arr(j, 22) > 8 Then
Thongbao(1) = "Thi" & ChrW(7871) & "u gi" & ChrW(7901) & " " & ChrW(259) & "n. Ki" & ChrW(7875) & "m tra b" & ChrW(7857) & "ng cách l" & ChrW(7885) & "c giá tr" & ChrW(7883) & " l" & ChrW(7899) & "n h" & ChrW(417) & "n 8 t" & ChrW(7841) & "i c" & ChrW(7897) & "t AA."
End If
ElseIf Arr(j, 23) > 0 Then
Arr(j, 30) = ofn.Round(Arr(j, 23) / 8, 2) & "D"
Else: Arr(j, 30) = 0
End If
'OK
'OVT N - D1 - D2 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++>
Arr(j, 31) = Arr(j, 24)
Arr(j, 32) = Arr(j, 25)
Arr(j, 33) = Arr(j, 26)
'OK
'Tong OVT - PC- OVT MAX +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++>
Arr(j, 34) = Arr(j, 31) + Arr(j, 32) + Arr(j, 33)
Arr(j, 35) = Arr(j, 28)
If max < Arr(j, 34) Then max = Arr(j, 34)
End If
Next j
Sh_HienHanh.Range("F9").Resize(Rws, 35).Value = Arr
Sh_HienHanh.Range("AX9").Resize(Rws, 1).Value = Ledem
Sh_HienHanh.Range("AY9").Resize(Rws, 1).Value = Lengay
'OVT max +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++>
Sh_HienHanh.Range("D1") = max
'Chuyen cong chu nhat, ngay le...............................................................................................
If Not IsEmpty(Range("A1")) Then
Arr = Sh_HienHanh.Range("N9").Resize(Rws, 22).Value
ReDim dArr(1 To Rws, 1 To 13)
For j = 1 To Rws
dArr(j, 1) = 0
dArr(j, 2) = 0
dArr(j, 3) = Arr(j, 14) + Arr(j, 16)
dArr(j, 4) = Arr(j, 15) + Arr(j, 17) + Arr(j, 18)
dArr(j, 5) = 0
dArr(j, 6) = dArr(j, 3) + dArr(j, 4)
dArr(j, 7) = Arr(j, 20)
dArr(j, 8) = Arr(j, 21)
dArr(j, 9) = 0
dArr(j, 10) = dArr(j, 3)
dArr(j, 11) = dArr(j, 4)
dArr(j, 12) = 0
dArr(j, 13) = dArr(j, 6)
Next j
Sh_HienHanh.Range("AA9").Resize(Rws, 13).Value2 = dArr
End If
'Tach bo phan...............................................................................................
Arr = Sh_HienHanh.Range("E9").Resize(Rws, 35).Value2
ReDim dArr(1 To Rws, 1 To 7)
For j = 1 To Rws
dArr(j, 1) = Arr(j, 1)
If dArr(j, 1) = "PRODUCTION" Then dArr(j, 1) = "PROD"
'Check Special Time +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++>
If Arr(j, 13) <= 0 Then
If Arr(j, 7) > 0 Or Arr(j, 8) > 0 Then
dArr(j, 2) = 1
Thongbao(3) = "Sai gi" & ChrW(7901) & " " & ChrW(273) & ChrW(7863) & "c bi" & ChrW(7879) & "t. Ki" & ChrW(7875) & "m tra b" & ChrW(7857) & "ng cách l" & ChrW(7885) & "c giá tr" & ChrW(7883) & " 1 c" & ChrW(7897) & "t AP."
End If
End If
'Check Cong-OVT +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++>
If Arr(j, 13) > 0 Then
If Arr(j, 2) = "D" Or Arr(j, 2) = "Z" Then
If Arr(j, 24) <> 8 Then
dArr(j, 3) = Arr(j, 24) - Arr(j, 22)
End If
Else:
If Arr(j, 23) <> 8 Then
dArr(j, 3) = Arr(j, 23) - Arr(j, 22)
End If
End If
End If
'Check so am +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++>
For i = 20 To 27
If Arr(j, i) < 0 Then
dArr(j, 4) = 1
Thongbao(4) = "Sai công, xu" & ChrW(7845) & "t hi" & ChrW(7879) & "n giá tr" & ChrW(7883) & " âm. Ki" & ChrW(7875) & "m tra b" & ChrW(7857) & "ng cách l" & ChrW(7885) & "c giá tr" & ChrW(7883) & " 1 c" & ChrW(7897) & "t AR."
End If
Next i
'Thong bao trung ID
If Sh_HienHanh.Range("B4") > 1 Then
Thongbao(5) = "Trùng ID. Ki" & ChrW(7875) & "m tra b" & ChrW(7857) & "ng cách l" & ChrW(7885) & "c giá tr" & ChrW(7883) & " l" & ChrW(7899) & "n h" & ChrW(417) & "n 1 t" & ChrW(7841) & "i c" & ChrW(7897) & "t A."
End If
'Chenh lech +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++>
CL = ofn.Round((Arr(j, 13) - (Arr(j, 5) - Arr(j, 4) + IIf(Arr(j, 5) < Arr(j, 4), 1, 0)) * 24), 1)
If Arr(j, 13) = 0 Then
If Arr(j, 4) = 0 Or Arr(j, 5) = 0 Then
dArr(j, 5) = 0
Else: dArr(j, 5) = "AKC" & CL
End If
ElseIf Arr(j, 7) > 0 Then
If Arr(j, 4) = 0 Then
dArr(j, 5) = "No in out " & CL
ElseIf Arr(j, 5) = 0 Then
dArr(j, 5) = "No in out " & CL
ElseIf Abs(Arr(j, 5) - Arr(j, 4)) < TimeSerial(1, 30, 0) Then
dArr(j, 5) = "Erro? " & CL
ElseIf CL > 0 Then
If Arr(j, 9) <> "S" Or Arr(j, 9) <> "M7" Then dArr(j, 5) = "Duong " & CL
ElseIf CL <= 0 Then
dArr(j, 5) = "Âm " & CL
End If
Else: dArr(j, 5) = "System " & CL
End If
'Check lech2 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++>
If Arr(j, 9) <> "S" Then
If Arr(j, 8) > 0 Then
If Arr(j, 8) > T24 Then
dArr(j, 6) = Arr(j, 8) - T24 - Arr(j, 5)
Else: dArr(j, 6) = Arr(j, 8) - Arr(j, 5)
End If
End If
End If
If dArr(j, 6) > 0 Then
dArr(j, 6) = "Duong" & " " & ofn.Text(dArr(j, 6), "hh:mm")
Else: dArr(j, 6) = 0
End If
'Phu cap 3 ca +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++>
Ca = Arr(j, 2)
If Arr(j, 13) > 0 Then
Select Case Ca
Case "X"
If Arr(j, 35) = 0 Then
dArr(j, 7) = Arr(j, 30)
End If
Case "Y"
If Arr(j, 35) = 0 Then
dArr(j, 7) = Arr(j, 30)
End If
Case "Z"
If Arr(j, 35) = 0 Then
dArr(j, 7) = Arr(j, 30)
End If
End Select
End If
Next j
Sh_HienHanh.Range("AO9").Resize(Rws, 7).Value2 = dArr
'Xoa bo dong thua...............................................................................................
Sh_HienHanh.Rows(Rws + 9 & ":" & Rws + 1000).Delete
Sh_HienHanh.Columns(52).Resize(, 30).Delete
'Tong thong bao
If Len(Thongbao(1) & Thongbao(2) & Thongbao(3) & Thongbao(4) & Thongbao(5)) > 0 Then
Sh_HienHanh.Range(Cells(9, 35), Cells(Rws + 8, 40)).ClearContents
Sheets("CPU").Range("T1").Resize(10, 1) = Application.WorksheetFunction.Transpose(Thongbao)
CanhBao.Show
End If
'So phong
sArr = Sh_HienHanh.Range("AO9").Resize(Rws, 1).Value2
Set Dic = CreateObject("Scripting.Dictionary")
k = 0
If Rws > 1 Then
For j = 1 To UBound(sArr)
Tem = sArr(j, 1)
If Not Dic.exists(Tem) And Not IsEmpty(sArr(j, 1)) Then
k = k + 1
Dic.Add sArr(j, 1), k
End If
Next
Sh_HienHanh.Range("C1") = k - 1
End If
'Bo phan thieu
k = 0
mangDL = Sh_Check.Range("A5").Resize(22, 32).Value2
maxRow = UBound(mangDL, 1): maxCol = UBound(mangDL, 2)
ReDim KQngang(0, 1 To maxRow)
ReDim KQdoc(1 To maxRow, 0)
For j = 2 To maxCol
If Sh_HienHanh.Name Like Day(mangDL(1, j)) Then
For i = 2 To 22
If mangDL(i, j) = 0 Then
k = k + 1
KQngang(0, k) = mangDL(i, 1)
KQdoc(k, 0) = mangDL(i, 1)
End If
Next i
Exit For
End If
Next j
If k Then Sh_HienHanh.Range("O1").Resize(1, k + 10) = KQngang
'Time finish...............................................................................................
Sh_HienHanh.Range("A3").Value2 = (GetTickCount - t) / 1000
End If
Call OnFunction
'Giai phong bien
Set Dic = Nothing
Set ofn = Nothing
Set Sh_HienHanh = Nothing
Set Sh_Form = Nothing
Set Sh_Check = Nothing
End Sub
PHP:
Private Sub Kiem_tra()
Dim Arr As Variant
Dim Rws As Long, i As Long, T24 As Single
Dim Ngay As Date
Set ofn = Application.WorksheetFunction
Ngay = ActiveSheet.Range("D3")
Rws = Range("C65536").End(xlUp).Row
Arr = Range("C9").Resize(Rws, 15).Value2
ReDim dArr(1 To Rws, 1 To 2)
For i = 1 To Rws
T24 = TimeSerial(24, 0, 0)
If Arr(i, 15) > 0 Then
If Arr(i, 12) <> "HROK" Then
If CStr(Arr(i, 9)) <> "" Then
If CStr(Arr(i, 10)) <> "" Then
If CStr(Arr(i, 11)) <> "" Then
'Vao
dArr(i, 1) = ofn.Round(Arr(i, 13) - (Arr(i, 6) - Ngay), 2)
If dArr(i, 1) > 0 Then
'Ra
dArr(i, 2) = ofn.Round((Arr(i, 7) - Ngay) - Arr(i, 14), 2)
End If
End If
End If
End If
End If
End If
Next i
Range("AV9").Resize(Rws, 2).Value2 = dArr
Set ofn = Nothing
End Sub
PHP:
Sub Morther()
With Sheets("Check")
.Range("B26:AF26").Copy
.Range("B27").PasteSpecial Paste:=xlPasteValues
End With
Call My_baby
Call Kiem_tra
End SubEm chạy sub Morther để gọi Sub My_baby và kiem_tra. Trong Sub My_baby có dòng CanhBao.Show. Nếu có lỗi thì sẽ chạy CanhBao.Show (3 Sub này đều nằm trong cùng một Modul). Bình thường mới chạy nó hiện rất nhanh, để một lúc sau là đơ như này mất 1 2 p mới hiện. Anh và mọi người thấy chỗ nào cần viết lại cho thanh thoát hiệu quả hơn thì chỉ em nhé
Lần chỉnh sửa cuối:
Upvote
0
Mình biết đọc nhìn lại code chắc ít ai làm ngoài những người đang học hỏi như mình thì có thể nghiền ngẫm các code mới của anh chị em, bạn bè trên forum. Và mình biết vậy nên ban đầu có Post code đâu, chỉ mô tả triệu chứng. Sau đó anh SA_DQ bảo thì mình mới post lên đấy chứ.
Upvote
0
Nên post file có code, và nói rõ mục đích code
Code muốn người khác đọc thì phải ghi chú (comment) trong code rõ ràng
Còn không thì như rừng, khó ai giúp được
Không ai tự thành lập file copy code trên để thử (thời gian) - trừ khi 1 sub ngắn 10 dòng thì may ra mọi người nhìn code và phán
Nhìn sơ thì hình như code bạn xử lý thời gian vào ra --> Nếu đúng thì nên bạn search công thức tính thời gian ca của bác Vietmini rồi áp dụng sang cho VBA sẽ gọn và nhanh hơn
Upvote
0
Code ấy cũng ở trên diễn đàn mình bạn ạ. Để thử xóa đi xem có bị không.
Upvote
0
Code trên diễn đàn thì bạn nhắn tin cho tác giả, hoặc đặt câu hỏi vào chủ đề có code đó thì tác giả sẽ giúp,
Muốn người khác giúp thì code phải có ghi chú, ghi chú chưa đủ cần phải giải thích mục đích, thuật toán của code nữa
(trừ những bài quá đơn giản như tính tổng 1 cột , tính tích 2 số ...vv)
Upvote
0
Uh vấn đề chưa chắc do cái code đó, vì ngày xưa dùng không vấn đề gì.
Upvote
0
vậy bạn thử xóa code đó đi (save as - copy sang file khác rồi xóa), thay bằng cái gì đó đơn giản, xem có chậm không
Upvote
0
Đến hôm nay em mới tìm được lý do.
Câu lệnh thông báo nằm trước các dòng lệnh này
Set Dic = Nothing
Set ofn = Nothing
Set Sh_Form = Nothing
Set Sh_Check = Nothing
Vì thế các bố kia không được giải phóng biến dẫn đến càng chạy càng đơ. Em điều chỉnh lại vị trí giờ ngon rồi
. Cảm ơn mọi người nhiều!
Upvote
0
Em xin mở rộng thêm một chút. Trường hợp em muốn bẫy lỗi mà đảm bảo hai yêu cầu:
1. Các biến được giải phóng theo ý mình.
2. Vẫn biết được báo lỗi ở đâu (Giống như là khi lỗi mình bấm Debug, nhưng trước đó xảy ra lỗi em muốn giải phóng một số biến nặng thì làm như nào ạ?
1. Các biến được giải phóng theo ý mình.
2. Vẫn biết được báo lỗi ở đâu (Giống như là khi lỗi mình bấm Debug, nhưng trước đó xảy ra lỗi em muốn giải phóng một số biến nặng thì làm như nào ạ?
Upvote
0
Cảm ơn bạn, để mình thử nhé.
Upvote
0
Bài viết mới nhất
- Question
