Sub chuyenbangchamcong()
Dim a As Long, b As Long, i As Long, lr As Long, c As Long
Dim arr, arr1(1 To 10000, 1 To 20)
Dim ngaybd As Date, ngaykt As Date, manv As Long, dk As String, dks As String
Dim sh As Worksheet
Dim dic As Object
Set dic = CreateObject("scripting.dictionary")
With Sheets("DATA")
If .Range("D1").Value = Empty Then ngaybd = 1 Else ngaybd = .Range("d1").Value
If .Range("E1").Value = Empty Then ngaykt = 100000 Else ngaykt = .Range("E1").Value
manv = .Range("D2").Value
lr = .Range("B" & Rows.Count).End(xlUp).Row
If lr > 5 Then .Range("A6:l" & lr).ClearContents
End With
dk = "#15#17#18#"
For Each sh In ThisWorkbook.Worksheets
If InStr(dk, "#" & sh.Name & "#") Then
lr = sh.Range("B" & Rows.Count).End(xlUp).Row
If lr > 2 Then
arr = sh.Range("A3:C" & lr).Value
For i = 1 To UBound(arr, 1)
If CLng(arr(i, 2)) >= CLng(ngaybd) And CLng(arr(i, 2)) <= CLng(ngaykt) Then
dks = arr(i, 1) & "#" & arr(i, 2)
If manv = Empty Then
If Not dic.exists(dks) Then
a = a + 1
arr1(a, 1) = arr(i, 1)
arr1(a, 2) = arr(i, 2)
arr1(a, 3) = doingay(arr(i, 2))
arr1(a, 5) = arr(i, 3)
dic.Item(dks) = Array(a, 5)
Else
b = dic.Item(dks)(0)
c = dic.Item(dks)(1) + 1
arr1(b, c) = arr(i, 3)
dic.Item(dks) = Array(b, c)
End If
ElseIf CStr(manv) = CStr(arr(i, 1)) Then
If Not dic.exists(dks) Then
a = a + 1
arr1(a, 1) = arr(i, 1)
arr1(a, 2) = arr(i, 2)
arr1(a, 3) = doingay(arr(i, 2))
arr1(a, 5) = arr(i, 3)
dic.Item(dks) = Array(a, 5)
Else
b = dic.Item(dks)(0)
c = dic.Item(dks)(1) + 1
arr1(b, c) = arr(i, 3)
dic.Item(dks) = Array(b, c)
End If
End If
End If
Next i
End If
End If
Next
With Sheets("Msnv")
lr = .Range("B" & Rows.Count).End(xlUp).Row
If lr > 2 Then
arr = .Range("A3:C" & lr).Value
For i = 1 To UBound(arr, 1)
dic.Add arr(i, 1), arr(i, 2)
Next i
End If
If a Then
For i = 1 To a
If dic.exists(arr1(i, 1)) Then
arr1(i, 4) = dic.Item(arr1(i, 1))
End If
Next i
Else
MsgBox "khong tim thay gi"
Exit Sub
End If
End With
With Sheets("DATA")
.Range("A6").Resize(a, 12).Value = arr1
End With
End Sub
Function doingay(ByVal ngay As Long)
Dim thu As String, a As Integer
a = ngay Mod 7
If a = 1 Then
doingay = "CN"
ElseIf a = 0 Then
doingay = "T7"
Else
doingay = "T" & a
End If
End Function