Sub TongHop()
Dim sArr(), DonVi(), Nghi(), Res(), Dic As Object
Dim NgayD As Date, NgayC As Date, fCol As Long, eCol As Long
Dim sR As Long, i As Long, ik As Long, j As Long, jk As Long
Dim tmp As String
With Sheets("BaoCao")
NgayD = .Range("K2").Value
NgayC = .Range("R2").Value
Nghi = .Range("C5:U5").Value
DonVi = .Range("A6:B" & .Range("B100000").End(xlUp).Row).Value
sR = UBound(DonVi)
End With
With Sheets("data")
jk = .Range("I4").End(xlToRight).Column
sArr = .Range("A7").Resize(.Range("C100000").End(xlUp).Row, jk).Value
For j = 9 To jk
If .Cells(4, j).Value >= NgayD Then fCol = j: Exit For
Next j
For j = jk To 9 Step -1
If .Cells(4, j).Value <= NgayC Then eCol = j: Exit For
Next j
If eCol < fCol Or eCol = 0 Or fCol = 0 Then MsgBox ("Ngay thang Sai"): Exit Sub
End With
ReDim Res(1 To sR, 1 To 24)
Set Dic = CreateObject("scripting.dictionary")
For j = 4 To UBound(Nghi, 2)
If Len(Nghi(1, j)) > 0 Then Dic.Add Nghi(1, j), j
Next j
For i = 1 To sR - 1
If InStr(1, DonVi(i + 1, 1), DonVi(i, 1) & ".") = 0 Then
Dic.Add DonVi(i, 2), i
End If
Next i
For i = 1 To UBound(sArr)
ik = Dic.Item(sArr(i, 3))
If ik > 0 Then
Res(ik, 1) = Res(ik, 1) + 1
For j = fCol To eCol
jk = Dic.Item(sArr(i, j))
If jk > 0 Then
Res(ik, jk) = Res(ik, jk) + 1
If InStr(1, ",O,BP,BÙ,CT,", "," & sArr(i, j) & ",") = 0 Then
Res(ik, 3) = Res(ik, 3) + 1
End If
End If
Next j
If sArr(i, 7) > 0 Then Res(ik, 22) = Res(ik, 22) + sArr(i, 7)
If sArr(i, 8) > 0 Then Res(ik, 23) = Res(ik, 23) + sArr(i, 8)
If sArr(i, 5) > 0 Then Res(ik, 24) = Res(ik, 24) + 1
End If
Next i
For i = 1 To sR - 1
If Dic.Item(DonVi(i, 2)) = 0 Then
For ik = i + 1 To sR - 1
If InStr(1, DonVi(ik, 1), DonVi(i, 1) & ".") = 1 Then
For j = 1 To UBound(Res, 2)
If Res(ik, j) > 0 Then Res(i, j) = Res(i, j) + Res(ik, j)
Next j
Else
Exit For
End If
Next ik
Else
For j = 1 To UBound(Res, 2)
If Res(i, j) > 0 Then Res(sR, j) = Res(sR, j) + Res(i, j)
Next j
End If
Next i
With Sheets("Baocao")
.Range("C6").Resize(sR, UBound(Res, 2)) = Res
.Activate
.Range("D6").Select
End With
End Sub
