Public Sub GPE()
Dim Arr(), dArr(), i As Long, k As Long, jMax As Long
With Sheet2
Arr = .Range("B4:D4" & i).Value
Range("B4").CurrentRegion.Clear
.Range("B4:D4" & i) = Arr
i = Sheet1.Range("G" & Rows.Count).End(xlUp).Row
Arr = Sheet1.Range("G5:G" & i).Value
.Range("M2").Resize(UBound(Arr)) = Arr
Arr = Sheet1.Range("O5:O" & i).Value
.Range("L2").Resize(UBound(Arr)) = Arr
.Range("L2:M2").Resize(UBound(Arr)).Sort .Range("L2"), 1, .Range("M2"), , 1, Header:=xlNo
dArr = .Range("L1:M1").Resize(UBound(Arr) + 1).Value
.Range("L2:M2").Resize(UBound(Arr)).ClearContents
ReDim Arr(1 To UBound(dArr, 1) - 1, 1 To 300) 'Neu khong du thi tang so 300 len
jMax = 3
For i = 2 To UBound(dArr, 1)
If dArr(i, 1) <> dArr(i - 1, 1) Then
k = k + 1
Arr(k, 1) = dArr(i, 1)
Arr(k, 2) = 1
Arr(k, 3) = dArr(i, 2)
Else
Arr(k, 2) = Arr(k, 2) + 1
Arr(k, Arr(k, 2) + 2) = dArr(i, 2)
If jMax < Arr(k, 2) + 2 Then jMax = Arr(k, 2) + 2
End If
Next i
.Range("B5").Resize(k, jMax) = Arr
Range("B4").CurrentRegion.Borders.LineStyle = 1
End With
End Sub
