Sub Cong_ngay_le_ngaynghi()
Dim Arr() As Variant
Dim Rws As Long, J As Long, I As Long, lr As Long, Tmr As Double, tR1 As Double, tR2 As Double
Dim Sht As String, SheetName As String
Tmr = Timer()
SheetName = InputBox("Nhap ten sheet can cham cong", "TUE ANH")
If SheetExists(SheetName) Then
MsgBox SheetName
End If
lr = [c65000].End(3).Row
Range(Cells(lr + 1, 1), Cells(lr + 10000, 45)).Clear
Rws = [b9].CurrentRegion.Rows.Count - 8
Arr() = [F9].Resize(Rws, 8).Value
ReDim dArr(1 To Rws, 1 To 3)
ReDim a1Arr(1 To Rws, 1 To 1)'Dinh dang
[A5:AS5].Copy
[A9].Resize(Rws, 45).PasteSpecial Paste:=xlPasteFormats
[H9].Resize(Rws, 2).Replace What:="(+1)", Replacement:=""
'Tong Thòi Gian Làm Viec:'
For J = 1 To UBound(Arr())
Sht = Arr(J, 1)
If Arr(J, 6) <> "" And Arr(J, 7) <> "" And Arr(J, 8) <> "" Then
dArr(J, 1) = Arr(J, 6): dArr(J, 2) = Arr(J, 7)
ElseIf Arr(J, 3) <= GQC(Sht) And Arr(J, 4) >= GQC(Sht, False) Then
dArr(J, 1) = GQC(Sht)
dArr(J, 2) = GQC(Sht, False)
End If
dArr(J, 3) = (dArr(J, 2) - dArr(J, 1)) * 24
Next J
[o9].Resize(Rws, 3).Value = dArr()
'Com Giua Ca I:
Arr() = [R9].Resize(Rws, 2).Value
ReDim dArr(1 To Rws, 1 To 1)
For J = 1 To UBound(Arr())
If Arr(J, 2) <> "" Then
dArr(J, 1) = Round((Arr(J, 2) - Arr(J, 1)) * 24, 2) + IIf(Round((Arr(J, 2) - Arr(J, 1)) * 24, 2) = 0.5, 0.5, 0)
End If
Next J
[t9].Resize(Rws).Value = dArr()
'Com Giua Ca II:'
Arr() = [U9].Resize(Rws, 2).Value
ReDim dArr(1 To Rws, 1 To 1)
For J = 1 To UBound(Arr())
If Arr(J, 2) <> "" Then
dArr(J, 1) = Round((Arr(J, 2) - Arr(J, 1)) * 24, 2)
End If
Next J
[W9].Resize(Rws).Value = dArr()
'Ma hoa chuc vu
Arr() = [G9].Resize(Rws).Value
ReDim dArr(1 To Rws, 1 To 1)
For J = 1 To UBound(Arr())
If Arr(J, 1) = "Senior Manager" Then
dArr(J, 1) = "A"
ElseIf Arr(J, 1) = "Manager" Then
dArr(J, 1) = "B"
ElseIf Arr(J, 1) = "Ast Manager" Then
dArr(J, 1) = "C"
Else
dArr(J, 1) = "D"
End If
Next J
[N9].Resize(Rws).Value = dArr()
'Danh so thu tu
Arr() = [C9].Resize(Rws).Value
ReDim dArr(1 To Rws, 1 To 1)
For J = 1 To UBound(Arr())
If Arr(J, 1) <> "" Then
dArr(J, 1) = J
End If
Next J
[A9].Resize(Rws).Value = dArr()
'Tong TG Làm Viec Thuc Te... X
'1
Arr() = [F9].Resize(Rws, 18).Value
ReDim dArr(1 To Rws, 1 To 2)
For J = 1 To UBound(Arr())
If Arr(J, 1) > w And Arr(J, 12) >= 8.5 Then
dArr(J, 1) = Arr(J, 12) - 0.5
Else
dArr(J, 1) = Round(Arr(J, 12) - Arr(J, 15) - Arr(J, 18), 2)
End If'Thoi gian huong che do Y
'2
dArr(J, 2) = IIf(Arr(J, 8) = "S", 1, 0)
Next J
[X9].Resize(Rws, 2).Value = dArr()
'Tong TG Làm Viec Duoc Tinh Z
'1
Arr() = [F9].Resize(Rws, 21).Value
ReDim dArr(1 To Rws, 1 To 3)
For J = 1 To UBound(Arr())
If Arr(J, 1) = "H" Or Arr(J, 1) = "N" Then
dArr(J, 1) = Arr(J, 12) - Arr(J, 15) - IIf(Arr(J, 11) <= [Q8], Arr(J, 18), 0)
Else
dArr(J, 1) = Arr(J, 12)
End If'Cong Ngay
'2
If Arr(J, 1) = "H" Or Arr(J, 1) = "N" Then
dArr(J, 2) = (IIf(Arr(J, 11) >= [AA7], [AA7], Arr(J, 11)) - IIf(Arr(J, 10) <> 0 And Arr(J, 10) - [Q7] <= 0, [Q7], Arr(J, 10))) * 24 - Arr(J, 15)
ElseIf Arr(J, 1) = "D" Or Arr(J, 1) = "Z" Then
dArr(J, 2) = 0
ElseIf Arr(J, 1) = "X" Then
dArr(J, 2) = (IIf(Arr(J, 11) - [AE7] >= 0, [AE7], Arr(J, 11)) - IIf(Arr(J, 10) <> 0 And Arr(J, 10) - [AD7] <= 0, [AD7], Arr(J, 10))) * 24
ElseIf Arr(J, 1) = "Y" Then
dArr(J, 2) = (IIf(Arr(J, 11) - [AC7] >= 0, [AC7], Arr(J, 11)) - IIf(Arr(J, 10) <> 0 And Arr(J, 10) - [AE7] <= 0, [AE7], Arr(J, 10))) * 24
Else: dArr(J, 2) = 0
End If
'Cong dem
'3
If Arr(J, 1) = "D" Or Arr(J, 1) = "Z" Then If Arr(J, 11) < [AC7] Then
dArr(J, 3) = 0
Else
dArr(J, 3) = (IIf(Arr(J, 11) - [AB7] >= 0, [AB7], Arr(J, 11)) - IIf(Arr(J, 10) <> 0 And Arr(J, 10) <= [AC7], [AC7], Arr(J, 10))) * 24
End If
Else
dArr(J, 3) = 0
End If
Next J
[Z9].Resize(Rws, 3).Value = dArr()'OVT ngay
'6Arr() = [F9].Resize(Rws, 23).Value
ReDim dArr(1 To Rws, 1 To 1)
For J = 1 To UBound(Arr())
If Arr(J, 10) >= [AC7] Then
dArr(J, 1) = 0
ElseIf Arr(J, 11) <= [AC7] Then
dArr(J, 1) = Arr(J, 21) - Arr(J, 22) - Arr(J, 23)
Else: dArr(J, 1) = Arr(J, 21) - Arr(J, 22) - (Arr(J, 11) - [AC7]) * 24
End If
dArr(J, 1) = Round(dArr(J, 1), 2)
Next J
[AC9].Resize(Rws, 1).Value = dArr()
'OVT D1-D2Arr() = [Y9].Resize(Rws, 5).Value
ReDim dArr(1 To Rws, 1 To 2)
For J = 1 To UBound(Arr())
If Arr(J, 5) > 0 Then
dArr(J, 1) = Round(Arr(J, 2) - Arr(J, 3) - Arr(J, 4) - Arr(J, 5), 2)
dArr(J, 2) = 0
Else
dArr(J, 1) = 0
dArr(J, 2) = Round(Arr(J, 2) - Arr(J, 3) - Arr(J, 4) - Arr(J, 5), 2)
End If
Next J
[AD9].Resize(Rws, 2).Value = dArr()
'OVT chu nhat
Arr() = [AA9].Resize(Rws, 5).Value
ReDim dArr(1 To Rws, 1 To 4)
For J = 1 To UBound(Arr())
dArr(J, 1) = 0
dArr(J, 2) = 0
dArr(J, 3) = Arr(J, 1) + Arr(J, 3)
dArr(J, 4) = Arr(J, 2) + Arr(J, 4) + Arr(J, 5)
Next J
[AA9].Resize(Rws, 4).Value = dArr()'Tong OVT
Arr() = [AC9].Resize(Rws, 3).Value
ReDim dArr(1 To Rws, 1 To 1)
For J = 1 To UBound(Arr())
dArr(J, 1) = Arr(J, 1) + Arr(J, 2) + Arr(J, 3)
Next J
[AF9].Resize(Rws).Value = dArr()
'PC mua cao diem
Arr() = [F9].Resize(Rws, 14).Value
ReDim dArr(1 To Rws, 1 To 1)
For J = 1 To UBound(Arr())
If Arr(J, 1) = "H" Or Arr(J, 1) = "N" Then
If Round(Arr(J, 14) - Arr(J, 13), 2) = 0.02 Then
dArr(J, 1) = "A"
Else: dArr(J, 1) = 0
End If
ElseIf Arr(J, 1) <> "H" Or Arr(J, 1) <> "N" Then
dArr(J, 1) = 0
End If
Next J
[AG9].Resize(Rws).Value = dArr()
'Quy ra cong
Arr() = [F9].Resize(Rws, 28).Value
ReDim dArr(1 To Rws, 1 To 7)
For J = 1 To UBound(Arr())
If Arr(J, 21) = 0 Then
dArr(J, 1) = "N"
ElseIf Arr(J, 22) <> 0 Then
dArr(J, 1) = Round(Arr(J, 22) / 8, 2) & Arr(J, 1)
Else
dArr(J, 1) = Round(Arr(J, 23) / 8, 2) & Arr(J, 1)
End If
If Arr(J, 1) = "LT" Then
dArr(J, 2) = "LT"
ElseIf Arr(J, 21) = 0 Then
dArr(J, 2) = "N"
ElseIf Arr(J, 1) = "X" Or Arr(J, 1) = "Y" Or Arr(J, 1) = "N" Or Arr(J, 1) = "H" Then
dArr(J, 2) = Round((Arr(J, 22) / 8), 2)
ElseIf dArr(J, 1) = "1Z" Or dArr(J, 1) = "1D" Then
dArr(J, 2) = "D"
Else:
dArr(J, 2) = dArr(J, 1)
End If
If Arr(J, 9) < "C" Then
dArr(J, 3) = Arr(J, 24) * 0.3
dArr(J, 4) = Arr(J, 25) * 0.3
dArr(J, 5) = Arr(J, 26) * 0.3
ElseIf Arr(J, 9) = "C" Then
dArr(J, 3) = Arr(J, 24) * 0.5
dArr(J, 4) = Arr(J, 25) * 0.5
dArr(J, 5) = Arr(J, 26) * 0.5
Else:
dArr(J, 3) = Arr(J, 24)
dArr(J, 4) = Arr(J, 25)
dArr(J, 5) = Arr(J, 26)
End If
dArr(J, 6) = dArr(J, 3) + dArr(J, 4) + dArr(J, 5)
dArr(J, 7) = Arr(J, 28)
Next J
[AH9].Resize(Rws, 7).Value = dArr()
[A3].Value = Timer() - Tmr
End SubFunction GQC(Shift As String, Optional Vo As Boolean = True) As Double
Select Case Shift
Case "D"
If Vo Then
GQC = TimeSerial(20, 0, 0)
Else
GQC = TimeSerial(32, 0, 0)
End If
Case "H"
If Vo Then
GQC = TimeSerial(8, 0, 0)
Else
GQC = TimeSerial(17, 0, 0)
End If
Case "N"
If Vo Then
GQC = TimeSerial(8, 0, 0)
Else
GQC = TimeSerial(20, 0, 0)
End If
Case "X"
If Vo Then
GQC = TimeSerial(6, 0, 0)
Else
GQC = TimeSerial(14, 0, 0)
End If
Case "Y"
If Vo Then
GQC = TimeSerial(14, 0, 0)
Else
GQC = TimeSerial(22, 0, 0)
End If
Case "Z"
If Vo Then
GQC = TimeSerial(22, 0, 0)
Else
GQC = TimeSerial(30, 0, 0)
End If
End Select
End Function Function SheetExists(ByVal SheetName As String) As Boolean
On Error Resume Next
SheetExists = Not Sheets(SheetName) Is Nothing
End Function