Option Explicit
Sub XYZ()
Dim aData(), aKB(), Res(), sRow&, sR&, i&, r&, k&
Dim tinh$, may$, fTime, eTime, tmp, iTime
Dim den As Boolean, di As Boolean, thoa As Boolean, bd As Boolean
aKB = Sheet1.Range("A2", Sheet1.Range("D" & Rows.Count).End(xlUp)).Value
ReDim Res(1 To UBound(aKB), 1 To 1)
With Sheet2
aData = .Range("B2", Sheet2.Range("F" & Rows.Count).End(xlUp)).Value
sRow = UBound(aData)
For r = 1 To sRow
aData(r, 4) = aData(r, 2) & aData(r, 3)
tmp = aData(r, 5)
aData(r, 5) = CDate(Mid(tmp, 7, 4) & Mid(tmp, 3, 4) & Mid(tmp, 1, 2) & Mid(tmp, 11, 9))
Next r
.Range("H2").Resize(sRow, 5) = aData
.Range("H2").Resize(sRow, 5).Sort .Range("H2"), 1, .Range("K2"), , 1, .Range("L2"), 1, xlNo
sRow = sRow + 1
aData = .Range("H2").Resize(sRow, 5).Value
.Range("H2").Resize(sRow, 5).ClearContents
End With
sR = UBound(aKB)
For i = 1 To sR
tinh = aKB(i, 1): may = aKB(i, 2)
tmp = aKB(i, 3)
fTime = CDate(Mid(tmp, 7, 4) & Mid(tmp, 3, 4) & Mid(tmp, 1, 2) & Mid(tmp, 11, 9))
tmp = aKB(i, 4)
eTime = CDate(Mid(tmp, 7, 4) & Mid(tmp, 3, 4) & Mid(tmp, 1, 2) & Mid(tmp, 11, 9))
Res(i, 1) = "No": thoa = False: bd = False: di = False: den = False
For r = 1 To sRow
If aData(r, 1) = tinh And aData(r, 4) = may Then
If thoa = False Then thoa = True
iTime = aData(r, 5)
If aData(r, 2) = may Then 'TB Den
If bd = False Then bd = True
If iTime < fTime Then den = True Else den = False
Else 'TB Di
If iTime >= eTime Then
If bd = False Then den = True
di = True
If di = True And den = True Then Res(i, 1) = "Ok": Exit For
Else
di = False
End If
If bd = False Then bd = True
End If
Else
If thoa = True Then
If den = True Then Res(i, 1) = "Ok"
Exit For
End If
End If
Next r
Next i
Sheet1.Range("E2").Resize(sR) = Res
End Sub
