Sub FilterAndUnique()
Dim lastRow As Long, k As Long, r As Long, ngay As Long, pos As Long, size As Long, currRow As Long
Dim MaID As String, s As String, ca As String, text As String, data(), result(), dic As Object
With ThisWorkbook.Worksheets("DL")
lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
If lastRow < 2 Then Exit Sub
data = .Range("A2:F" & lastRow).Value
End With
ReDim result(1 To 10000, 1 To 4)
With ThisWorkbook.Worksheets("KQ")
ngay = .Range("C1").Value
ca = LCase(.Range("C2").Value)
.Range("A5:D10000").ClearContents
End With
Set dic = CreateObject("Scripting.Dictionary")
currRow = 0
For r = 1 To UBound(data)
If (CDbl(data(r, 4)) >= ngay) And (CDbl(data(r, 4)) <= ngay + 1) Then
If ca = "all" Or ca = LCase(data(r, 5)) Then
s = data(r, 1) & "/"
pos = 1
size = Len(s)
text = String(58, Chr(0))
Mid(text, 17, Len(data(r, 2))) = data(r, 2)
Mid(text, 33, Len(data(r, 3))) = data(r, 3)
Mid(text, 49, Len(data(r, 6))) = data(r, 6)
Do While pos < size
k = InStr(pos, s, "/")
MaID = Mid(s, pos, k - pos)
Mid(text, 1, Len(MaID)) = MaID
pos = k + 1
If Not dic.exists(text) Then
currRow = currRow + 1
dic.Add text, ""
result(currRow, 1) = MaID
result(currRow, 2) = data(r, 2)
result(currRow, 3) = data(r, 3)
result(currRow, 4) = data(r, 6)
End If
Loop
End If
End If
Next r
If currRow Then ThisWorkbook.Worksheets("KQ").Range("A5").Resize(currRow, 4).Value = result
Set dic = Nothing
End Sub
