Sub KiemTraKhaiBao_Fix()
Dim dic As Object, sKey As String
Dim arrD, arrTmp, arrChk, arrN
Dim i As Long, k As Long
Dim tmr As Double, DDate As Date
Application.ScreenUpdating = False
arrTmp = Sheet2.Range("B2:F" & Sheet2.Range("B" & Rows.Count).End(xlUp).Row)
Set dic = CreateObject("Scripting.Dictionary")
ReDim arrD(1 To UBound(arrTmp, 1), 1 To 4)
For i = 1 To UBound(arrTmp, 1)
sKey = UCase(Trim(arrTmp(i, 1)) & "|" & IIf(arrTmp(i, 2) <> "", Trim(arrTmp(i, 2)), Trim(arrTmp(i, 3))))
If Not dic.Exists(sKey & "-" & 1) Then
k = k + 1
dic.Add (sKey & "-" & "1"), k
arrD(k, 1) = sKey
arrD(k, 4) = 1
If arrTmp(i, 2) <> "" Then
arrD(k, 2) = CDate(arrTmp(i, 5))
arrD(k, 3) = Date
Else
arrD(k, 3) = CDate(arrTmp(i, 5))
arrD(k, 2) = CDate(arrTmp(1, 5))
End If
Else
If arrTmp(i, 2) = "" Then
arrD(dic.Item(sKey & "-" & arrD(dic.Item(sKey & "-" & 1), 4)), 3) = CDate(arrTmp(i, 5))
Else
k = k + 1
dic.Add (arrD(dic.Item(sKey & "-" & 1), 1) & "-" & (arrD(dic.Item(sKey & "-" & 1), 4) + 1)), k
arrD(k, 1) = sKey
arrD(k, 2) = CDate(arrTmp(i, 5))
arrD(k, 3) = Date
arrD(dic.Item(sKey & "-" & 1), 4) = arrD(dic.Item(sKey & "-" & 1), 4) + 1
End If
End If
Next
Set dic = Nothing
arrN = Sheet1.Range("A2:D" & Sheet1.Range("A" & Rows.Count).End(xlUp).Row)
ReDim arrChk(1 To UBound(arrN, 1), 1 To 1)
For i = 1 To UBound(arrN, 1)
sKey = UCase(Trim(arrN(i, 1)) & "|" & Trim(arrN(i, 2)))
For k = 1 To UBound(arrD, 1)
If sKey = arrD(k, 1) Then
If CDate(arrN(i, 3)) >= arrD(k, 2) And CDate(arrN(i, 3)) <= arrD(k, 3) And _
CDate(arrN(i, 4)) >= arrD(k, 2) And CDate(arrN(i, 4)) <= arrD(k, 3) Then
arrChk(i, 1) = "OK"
Exit For
End If
End If
Next
If arrChk(i, 1) = "" Then arrChk(i, 1) = "NOK"
Next
Sheet1.Range("E2").Resize(UBound(arrN, 1), 1) = arrChk
End Sub
