Option Explicit
Sub Kiemtra()
Dim Arr, J As Long, Dongcuoi As Long
Dim SRng As Range, eRng As Range, Cll As Range
Arr = Array(15, 16, 18, 19, 21, 22, 24, 25)
Dongcuoi = Range("A" & Rows.Count).End(xlUp).Row
For J = LBound(Arr) To UBound(Arr)
Set SRng = Range(Cells(9, Arr(J)), Cells(Dongcuoi, Arr(J)))
Select Case Arr(J)
Case 15, 18, 21, 24 To 25
Kiemtrangay SRng
Case 16, 19, 22
Kiemtragio SRng
End Select
Next J
End Sub
Sub Kiemtrangay(ByVal SRng As Range)
Dim Rng As Range, Cll As Range
Dim fYear As Long, eYear As Long
fYear = Year(Now()) - 4: eYear = Year(Now()) + 1
SRng.Interior.Pattern = xlNone
SRng.Font.Strikethrough = False
For Each Cll In SRng
If IsError(Cll) Then GoTo Tiep
If Cll <> Empty And Not IsDate(Cll) Then GoTo Tiep
If Cll <> Empty Then
If Year(Cll) <= fYear Then
If Year(Cll) <= eYear Then
Tiep:
If Rng Is Nothing Then
Set Rng = Cll
Else
Set Rng = Union(Rng, Cll)
End If
End If
End If
End If
Next
If Not Rng Is Nothing Then
Rng.Interior.Color = 7988676
Rng.Font.Strikethrough = True
End If
End Sub
Sub Kiemtragio(ByVal SRng As Range)
Dim Rng As Range, Cll As Range, DK As Boolean
Dim aTmp, TmpBD, TmpKT, J As Long
Dim GioBD As Double, GioKT As Double, FGio As Double, EGio As Double
Dim sTimeAm As Double, eTimeAM As Double, sTimePM As Double, eTimePM As Double
sTimeAm = 7 + 30 / 60: eTimeAM = 11 + 30 / 60
sTimePM = 13 + 30 / 60: eTimePM = 17
SRng.Interior.Pattern = xlNone
SRng.Font.Strikethrough = False
For Each Cll In SRng
DK = False
If IsError(Cll) Then
DK = True: GoTo Tiep
End If
If Cll <> Empty Then
aTmp = Split(Cll, "-")
If UBound(aTmp) < 1 Then
DK = True: GoTo Tiep
Else
TmpBD = Split(aTmp(0), "h")
TmpKT = Split(aTmp(1), "h")
'-----------------------------------------------
If UBound(TmpBD) >= 1 Then
GioBD = CLng(TmpBD(0)) + CLng(TmpBD(1)) / 60
'++++++++++++++++++++++++
If GioBD < eTimeAM Then
FGio = sTimeAm: EGio = eTimeAM
Else
FGio = sTimePM: EGio = eTimePM
End If
'+++++++++++++++++++++++++
If GioBD < FGio Then
DK = True: GoTo Tiep
End If
Else
DK = True: GoTo Tiep
End If
'---------------------------------------------------
If UBound(TmpKT) >= 1 Then
GioKT = CLng(TmpKT(0)) + CLng(TmpKT(1)) / 60
If GioKT > EGio Then
DK = True: GoTo Tiep
End If
Else
DK = True: GoTo Tiep
End If
'------------------------------------------
If GioKT - GioBD <= 0 Then
DK = True: GoTo Tiep
End If
End If
End If
Tiep:
If DK = True Then
If Rng Is Nothing Then
Set Rng = Cll
Else
Set Rng = Union(Rng, Cll)
End If
End If
Next
If Not Rng Is Nothing Then
Rng.Interior.Color = 13434879
Rng.Font.Strikethrough = True
End If
End Sub
