Sub XYZ()
Dim sArr(), aHL(1 To 4, 1 To 2), res(1 To 6, 1 To 8)
Dim n&, i&, r&, c&, r2&, c2&, k&
With Sheets("Sheet1")
i = .Range("C" & Rows.Count).End(xlUp).Row
If i < 10 Then MsgBox ("Hos sinh qua it, giai tan lop!"): Exit Sub
sArr = .Range("A3:C" & i).Value
End With
For i = 1 To UBound(sArr)
aHL(sArr(i, 3), 1) = aHL(sArr(i, 3), 1) & "," & i
Next i
For n = 1 To 4
aHL(n, 1) = Split(aHL(n, 1), ",")
Next n
k = 0: r = 1: c = -1
For n = 1 To 2
For i = 1 To UBound(aHL(n, 1))
k = k + 1
If c = 7 Then c = 1: r = r + 1 Else c = c + 2
res(r, c) = aHL(n, 1)(i)
If k = 24 Then i = i + 1: Exit For
Next i
aHL(n, 2) = i - 1
If aHL(n, 2) < UBound(aHL(n, 1)) Then Exit For
Next n
k = 0: r2 = 1: c2 = 0
For n = 4 To 3 Step -1
For i = 1 To UBound(aHL(n, 1))
k = k + 1
If c2 = 8 Then c2 = 2: r2 = r2 + 1 Else c2 = c2 + 2
res(r2, c2) = aHL(n, 1)(i)
If k = 24 Then Exit For
Next i
aHL(n, 2) = i
Next n
If aHL(2, 2) < UBound(aHL(2, 1)) Then
For n = 1 To 2
For i = aHL(n, 2) + 1 To UBound(aHL(n, 1))
If c2 = 8 Then c2 = 2: r2 = r2 + 1 Else c2 = c2 + 2
res(r2, c2) = aHL(n, 1)(i)
Next i
Next n
Else
For n = 4 To 3 Step -1
For i = aHL(n, 2) + 1 To UBound(aHL(n, 1))
If c = 7 Then c = 1: r = r + 1 Else c = c + 2
res(r, c) = aHL(n, 1)(i)
Next i
Next n
End If
Sheets("Sheet1").Range("E3").Resize(6, 8) = res
End Sub
