' CHUONG TRINH XU LY DU LIEU CHO PHAN MEM QUAN LY VAO/RA CHAM CONG '
' RFID_COLTECH 1.0 '
' MECHATRONICS LAB, TRUONG DAI HOC CONG NGHE, DHQG HA NOI '
Option Explicit
Dim endR As Long, i As Long, s As Long, k As Long, endM As Long, fM As Long
Dim ArrCT(), ArrCC(), Arr(), ArrTotalDM(), ArrTotalCT()
Dim iPhong As String
Dim myRng As Range
Dim Dic As Object
Dim Wf As WorksheetFunction
Dim fDate As Date, iDate As Date
Sub TaoTH()
Set Wf = WorksheetFunction
With Application
.ScreenUpdating = False: .Calculation = xlCalculationManual
End With
With Sheets("Bangchitiet")
endR = .Cells(1000, 1).End(xlUp).Row
ArrCT = .Range("A6:I" & endR).Value
End With
ReDim ArrCC(1 To UBound(ArrCT), 1 To 8)
With Sheets("BangChamCong")
.Range("A11:I1000").ClearContents 'Xoa du lieu cu'
iPhong = .[C8]
End With
'THUC HIEN TINH TOAN'
s = 0
For i = 1 To UBound(ArrCT)
If ArrCT(i, 4) = iPhong Then
s = s + 1
'ArrCC(s, 1) = s 'So TT''
ArrCC(s, 1) = CStr(ArrCT(i, 3)) 'Mathe'
ArrCC(s, 2) = ArrCT(i, 2) 'Ten NV'
ArrCC(s, 3) = ArrCT(i, 6) 'Ngay'
ArrCC(s, 4) = ArrCT(i, 7) 'Gio vao'
ArrCC(s, 5) = ArrCT(i, 8) 'Gio ra'
ArrCC(s, 8) = ArrCT(i, 9) 'TG lam viec'
If Len(ArrCT(i, 8)) > 0 Then
With Wf
ArrCC(s, 6) = .Max(CDate(ArrCC(s, 4)) - CDate("08:00:00 AM"), 0) 'Di muon'
ArrCC(s, 7) = .Max(CDate("05:00:00 PM") - CDate(ArrCC(s, 5)), 0) 'Ve som'
End With
Else
ArrCC(s, 5) = "No" ' Khong quet the'
End If
'Truong hop khong vi pham'
If ArrCC(s, 6) = 0 Then
ArrCC(s, 6) = ""
End If
If ArrCC(s, 7) = 0 Then
ArrCC(s, 7) = ""
End If
End If
Next i
If s = 0 Then GoTo Escape
With Sheets("BangChamCong")
.[A11].Resize(s, 8) = ArrCC
Set myRng = .[A11].Resize(s, 8)
End With
Erase ArrCT(), ArrCC()
SortBCC
'tao dong ngay tren sh bangcongthang
TaoDongNgay
TaoTHMonth
Erase ArrCC(), Arr(), ArrTotalDM(), ArrTotalCT()
Set myRng = Nothing: Set Wf = Nothing
Escape:
With Application
.ScreenUpdating = True: .Calculation = xlCalculationAutomatic
End With
End Sub
Sub TaoTHMonth()
ReDim ArrTotalDM(1 To UBound(ArrCC), 1 To 3)
ReDim ArrTotalCT(1 To UBound(ArrCC), 1 To 32)
s = 1
For i = 1 To UBound(ArrCC) - 1
k = Day(ArrCC(i, 3)) - 1
ArrTotalDM(s, 1) = s 'stt
ArrTotalDM(s, 2) = ArrCC(i, 2) 'ten
ArrTotalDM(s, 3) = ArrCC(i, 1) 'ma
ArrTotalCT(s, k) = ArrCC(i, 8) 'TG
ArrTotalCT(s, 32) = ArrTotalCT(s, 32) + ArrTotalCT(s, k) ' TG total
If ArrCC(i + 1, 1) <> ArrTotalDM(s, 3) Then s = s + 1
Next i
With Sheets("Bangcongthang")
.Range("A4:AJ1000").ClearContents
With .[A4]
.Resize(s, 3) = ArrTotalDM
End With
With .[D4]
.Resize(s, 32) = ArrTotalCT
End With
End With
End Sub
Sub TaoDongNgay()
Dim k As Long
'tao bangcongthang
s = s + 10
'tao lai arr theo da sort
With Sheets("BangChamCong")
ArrCC = .Range("A11:H" & s + 1).Value
Set myRng = .Range("C11:C" & s)
fDate = Wf.Min(myRng)
End With
endM = Day(DateSerial(Year(fDate), Month(fDate) + 1, 0))
'phuc tap vi muon dua ve 1
fM = Day(fDate): k = fM - 1
ReDim Arr(fM - k To endM - k)
For i = fM - k To endM - k
iDate = DateSerial(Year(fDate), Month(fDate), i + k)
Arr(i) = CDate(iDate)
Next i
With Sheets("Bangcongthang")
With .[D3]
.Resize(1, 31).ClearContents
.Resize(1, endM - fM + 1) = Arr
End With
End With
End Sub
Sub SortBCC()
With myRng
.Sort Key1:=myRng.Cells(1, 1), Order1:=xlAscending, Key2:=myRng.Cells(1, 3), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End With
End Sub
Nên còn non lắm.
