Option Explicit
Sub XYZ()
Dim arr(), resDT$(), res(), wb As Workbook, sh As Worksheet, dic As Object
Dim sRow&, sCol&, j&, i&, r&, k&, ik&, DT$, fDay&, eDay&, tDay
Set sh = ThisWorkbook.Worksheets("Tach KH")
Set dic = CreateObject("Scripting.Dictionary")
On Error Resume Next
fDay = sh.Range("G2").Value
eDay = sh.Range("H2").Value
If fDay = Empty Or eDay = Empty Or fDay > eDay Then
MsgBox ("Dieu kien ngay khong chuan !")
Exit Sub
End If
'Gan du lieu vao mang arr
Application.ScreenUpdating = False
Application.EnableEvents = False
Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & "DuLieu." & sh.Range("F1").Value)
arr = Range("A10:AS" & Range("E" & Rows.Count).End(xlUp).Row).Value
wb.Close False
If Err.Number > 0 Then
MsgBox ("File du lieu khong ton tai !")
Application.EnableEvents = True
Application.ScreenUpdating = True
Exit Sub
End If
On Error GoTo 0
sRow = UBound(arr): sCol = UBound(arr, 2)
'Loc du lieu
ReDim res(1 To sRow, 1 To 3)
ReDim resDT(1 To sRow, 1 To 1)
For i = 1 To sRow
If TypeName(arr(i, 41)) = "String" Then
tDay = CLng(Split(arr(i, 41), "/")(0))
Else
tDay = Day(arr(i, 41))
End If
If tDay >= fDay And tDay <= eDay Then
r = r + 1
If i <> r Then
For j = 1 To sCol
arr(r, j) = arr(i, j)
Next j
End If
DT = Trim(arr(i, 7))
If Not dic.exists(DT) Then
k = k + 1
dic.Add DT, k
res(k, 1) = arr(i, 5): res(k, 3) = 1
resDT(k, 1) = DT
Else
ik = dic.Item(DT)
res(ik, 3) = res(ik, 3) + 1
End If
End If
Next i
'Gan du lieu vao sheet Data
With Sheets("Data")
If .Range("B2").Value <> Empty Then .Range("B2").CurrentRegion.Offset(1).ClearContents
.Range("D2").Resize(r).NumberFormat = "@"
.Range("AO2").Resize(r).NumberFormat = "@"
.Range("A2").Resize(r, sCol) = arr
End With
'Xoa vung ket qua
i = sh.Range("B" & Rows.Count).End(xlUp).Row
If i > 3 Then sh.Range("A4:D" & i).ClearContents
'Gan ket qua
sh.Range("B4").Resize(k, 3) = res
sh.Range("C4").Resize(k) = resDT
sh.Range("B4").Resize(k, 3).Sort Key1:=sh.Range("D4"), Order1:=xlDescending
sh.Range("A4") = 1
sh.Range("A4").Resize(k).DataSeries
Call Add_Datavalidation(dic, resDT, k, i) 'Tao Data validation sheet "Gui Le"
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Sub Add_Datavalidation(dic, resDT, ByVal sRow&, ByVal i&)
dic.RemoveAll
For i = 1 To sRow
If Not dic.exists(resDT(i, 1)) Then dic.Add resDT(i, 1), ""
Next i
Sheets("Gui Le").Range("J2").Validation.Modify Formula1:=Join(dic.keys, ",")
End Sub
