Option Explicit
Sub baocao()
Dim lr&, i&, j&, m&, k&, n&, c&, rng, Src, st As String, nvA, chA, s, sb, cell As Range
Dim res(), list(1 To 10000, 1 To 2), ws As Worksheet
Dim dic As Object
Set dic = CreateObject("Scripting.Dictionary")
With Sheets("Data")
lr = .Cells(Rows.Count, "B").End(xlUp).Row
Src = .Range("A2:H" & lr).Value
End With
For Each ws In Sheets
Select Case ws.Name
Case "Cuahang": n = 2
Case "Nhanvien": n = 3
Case "Cap": n = 4
Case Else: GoTo NextSheet
End Select
ReDim res(1 To lr, 1 To 29)
For i = 1 To UBound(Src)
If Not dic.exists(Src(i, n)) Then
k = k + 1
dic.Add Src(i, n), ""
res(k, 1) = Src(i, n): res(k, Src(i, 8) + 1) = Src(i, 6)
res(k, 16) = Src(i, n): res(k, Src(i, 8) + 16) = 1
Else
For m = 1 To k
If res(m, 1) = Src(i, n) Then
res(m, Src(i, 8) + 1) = res(m, Src(i, 8) + 1) + Src(i, 6)
res(m, Src(i, 8) + 16) = res(m, Src(i, 8) + 16) + 1
Exit For
End If
Next
End If
Next
ws.Range("A3:AC10000").ClearFormats
ws.Range("A3:AC10000").ClearContents
ws.Range("A3").Resize(k, 29).Value = res
ws.Range("N3").Resize(k, 1).Formula = "=SUM(B3:M3)"
ws.Range("AC3").Resize(k, 1).Formula = "=SUM(Q3:AB3)"
With ws.Range("A3").Offset(k, 0)
.Value = "TOTAL"
.Offset(0, 1).Resize(1, 13).Formula = "=SUM(B3:B" & k + 2 & ")"
.Resize(1, 14).Copy .Offset(0, 15)
End With
With ws.Range("A1:N" & k + 3)
.Borders.LineStyle = xlContinuous
.NumberFormat = "#,##0.0"
End With
With ws.Range("P1:AC" & k + 3)
.Borders.LineStyle = xlContinuous
.NumberFormat = "#,##0.0"
End With
NextSheet: k = 0
Next
ReDim res(1 To 100000, 1 To 37): k = 0
With Sheets("Nhanvien")
lr = .Cells(Rows.Count, "A").End(xlUp).Row
rng = .Range("A3:M" & lr).Value
For i = 1 To UBound(rng) - 1
st = ""
For j = 2 To UBound(rng, 2)
If rng(i, j) >= 30000 Then st = st & IIf(st = "", "", "-") & j - 1
Next
If st <> "" Then
For m = 1 To UBound(Src)
If rng(i, 1) = Src(m, 3) Then
k = k + 1
list(k, 1) = Src(m, 4) & "@" & st
list(k, 2) = Src(m, 2) & "@" & st
End If
Next
End If
Next
End With
Sheets("Xeploai").Activate
Range("A3:AK10000").ClearFormats
Range("A3:AK10000").ClearContents
Sheets("Cap").Range("A3:A" & Sheets("Cap").Cells(Rows.Count, "A").End(xlUp).Row).Copy Range("A3")
Sheets("Cuahang").Range("A3:A" & Sheets("Cuahang").Cells(Rows.Count, "A").End(xlUp).Row).Copy Range("T3")
lr = Cells(Rows.Count, "A").End(xlUp).Row
nvA = Range("A3:R" & lr).Value
lr = Cells(Rows.Count, "T").End(xlUp).Row
chA = Range("T3:AK" & lr).Value
For j = 1 To 2
For i = 1 To k
s = Split(list(i, j), "@"): sb = Split(s(1), "-")
For n = 1 To UBound(nvA)
If s(0) = nvA(n, 1) Then
For m = 0 To UBound(sb)
nvA(n, sb(m) + 1) = nvA(n, sb(m) + 1) + 1
Next
End If
Next
For n = 1 To UBound(chA)
If s(0) = chA(n, 1) Then
For m = 0 To UBound(sb)
chA(n, sb(m) + 1) = chA(n, sb(m) + 1) + 1
Next
End If
Next
Next
Next
Range("A3").Resize(UBound(nvA), UBound(nvA, 2)).Value = nvA
Range("T3").Resize(UBound(chA), UBound(chA, 2)).Value = chA
Range("N3:N" & UBound(nvA) + 2).Formula = "=SUM(B3:D3)"
Range("O3:O" & UBound(nvA) + 2).Formula = "=SUM(E3:G3)"
Range("P3:P" & UBound(nvA) + 2).Formula = "=SUM(H3:J3)"
Range("Q3:Q" & UBound(nvA) + 2).Formula = "=SUM(K3:M3)"
Range("R3:R" & UBound(nvA) + 2).Formula = "=SUM(N3:Q3)"
Range(Cells(UBound(nvA) + 2, "B"), Cells(UBound(nvA) + 2, "R")).Formula = "=sum(B3:B" & UBound(nvA) + 1 & ")"
Range("N3:R3").Copy Range("AG3:AG" & UBound(chA) + 2)
Range(Cells(UBound(chA) + 2, "U"), Cells(UBound(chA) + 2, "AK")).Formula = "=sum(U3:U" & UBound(chA) + 1 & ")"
For Each cell In Union(Range("A2"), Range("T2"))
With cell.CurrentRegion
.Borders.LineStyle = xlContinuous
.NumberFormat = "#,###"
End With
Next
End Sub
