Xếp lớp học với Excel

Option Explicit
'định nghĩa các hằng gợi nhớ cần dùng
Const TSHS = 300 'tổng số học sinh trong danh sách
Const STARTROW = 2 'hàng chứa học sinh đầu tiên
Const SOCOT = 3 'số cột thông tin của mỗi học sinh
Const COTTR = 2 'chỉ số cột chứa mã (hay tên) trường
Const COTHL = 3 'chỉ số cột chứa điểm TK hay loại xếp hạng
'định nghĩa kiểu miêu tả lớp học
Type Lop
name As String
row As Integer
End Type
'định nghĩa danh sách các lớp
Dim aLop() As Lop

'macro tạo danh sách 300 học sinh giả
Sub TaoDSHS()
Dim rg As Range
Dim i As Integer, matr As Integer
Dim diem As Double
matr = 0: diem = 10
Sheets.Add
ActiveSheet.name = "DSHS"
Columns("A:A").ColumnWidth = 22
Cells(1, 1) = "Ho ten"
Cells(1, 2) = "Ma Truong"
Cells(1, 3) = "Diem TK"
Set rg = Range("A2:Z301")
For i = 1 To 300
rg.Cells(i, 1) = "Hoc sinh " & i
rg.Cells(i, 2) = matr
rg.Cells(i, 3) = diem
matr = matr + 1
If matr = 5 Then matr = 0
diem = diem - 0.1
If diem < 5="" then="" diem="">
Next i
End Sub

'thủ tục xếp lớp theo tiêu chuẩn 1
Sub Xeplop1(n As Integer)
'định nghĩa các biến cần dùng
Dim i As Integer
Dim col As Integer
Dim srhl As String
Dim srtr As String
'xác định vị trí cột điểm
srhl = Chr(COTHL + Asc("A") - 1) & STARTROW
'xác định vị trí cột mã trường
srtr = Chr(COTTR + Asc("A") - 1) & STARTROW
'copy DSHS từ sheet gốc sang sheet tạm
Sheets("DSHS").Copy Before:=Sheets(1)
'đặt tên sheet tạm
ActiveSheet.name = "DSTAM"
'thiết lập vùng cell chứa thông tin các học sinh
Set rg = Range("A" & STARTROW & ":Z" & (TSHS + STARTROW - 1))
rg.Select
'xếp danh sach học sinh theo trường
'mỗi trường xếp từ điểm cao -> thấp
Selection.Sort Key1:=Range(srtr), Order1:=xlAscending, Key2:=Range(srhl), Order2:=xlDescending, Header:=xlGuess, OrderCustom:=1, MatchCase:= False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 :=xlSortNormal
'cấp phát n record quản lý n lớp
ReDim aLop(1 To n)
'tạo n sheet chứa học sinh của n lớp
For i = 1 To n
Sheets.Add
ActiveSheet.name = "Lop " & i
aLop(i).name = "Lop " & i
aLop(i).row = STARTROW
'copy hàng tiêu đề từ sheet DSHS sang lớp i
For col = 1 To SOCOT
ActiveSheet.Cells(STARTROW - 1, col) = Sheets("DSTAM").Cells(STARTROW - 1, col)
Next col
Next i
'chọn sheet DSTAM để làm việc với nó
Sheets("DSTAM").Select
'gọi thủ tục Xeplop1t để xếp các học sinh
'vào n lớp theo tiêu chuẩn 1
Xeplop1t n, STARTROW
'xóa sheet tạm
Sheets("DSTAM").Select
ActiveWindow.SelectedSheets.Delete
End If

'Thủ tục xếp các học sinh vào n lớp theo tiêu chuẩn 1
Sub Xeplop1t(n As Integer, rstart As Integer)
'định nghĩa các biến cần dùng
Dim idt As Integer, i As Integer, il As Integer
Dim step As Integer
Dim col As Integer
Dim idxt(0 To 10) As Integer
Dim smt(0 To 10) As Integer
Dim rg As Range
Dim row As Integer, rmax As Integer
'xác định số trường tiểu học và
'vị trí học sinh đầu tiên của từng trường
idt = 0: idxt(0) = rstart
smt(0) = Cells(rstart, COTTR).Value
For i = rstart To STARTROW + TSHS - 1
If Cells(i, COTTR).Value <> smt(idt) Then
idt = idt + 1
idxt(idt) = i
smt(idt) = Cells(i, COTTR).Value
End If
Next i
'xếp các học sinh từng trường vào n lớp
il = 1: step = 1
For i = 0 To idt
row = idxt(i)
If i < idt="">
rmax = idxt(i + 1) - 1
Else
rmax = STARTROW + TSHS - 1
End If
While row <=>
'copy 1 học sinh từ sheet tạm sang lớp il
For col = 1 To SOCOT
Sheets(aLop(il).name).Cells(aLop(il).row, col) = Cells(row, col)
Next col
'cập nhật hàng cần thêm học sinh
aLop(il).row = aLop(il).row + 1
row = row + 1
'thay đổi lớp
il = il + step
If il > n Then
step = -1
il = n
End If
If il < 1="">
step = 1
il = 1
End If
Wend
Next i
End Sub

'thủ tục xếp lớp theo tiêu chuẩn 2
Sub Xeplop2(n As Integer)
'định nghĩa các biến cần dùng
Dim i As Integer, idt As Integer
Dim idxt(0 To 10) As Integer
Dim smt(0 To 10) As Integer
Dim rg As Range
Dim row As Integer, rmax As Integer
Dim col As Integer, SoHS As Integer, HSDu As Integer
Dim srhl As String
Dim srtr As String
'xác định vị trí cột điểm
srhl = Chr(COTHL + Asc("A") - 1) & STARTROW
'xác định vị trí cột mã trường
srtr = Chr(COTTR + Asc("A") - 1) & STARTROW
'copy DSHS từ sheet gốc sang sheet tạm
Sheets("DSHS").Copy Before:=Sheets(1)
'đặt tên sheet tạm
ActiveSheet.name = "DSTAM"
'thiết lập vùng cell chứa thông tin các học sinh
Set rg = Range("A" & STARTROW & ":Z" & (TSHS + STARTROW - 1))
rg.Select
'xếp danh sách học sinh theo thứ tự điểm từ cao -> thấp
Selection.Sort Key1:=Range(srhl), Order1:=xlDescending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
'cấp phát n record quản lý n lớp
ReDim aLop(1 To n)
'tạo n sheet chứa học sinh của n lớp
For i = 1 To n
Sheets.Add
ActiveSheet.name = "Lop " & i
aLop(i).name = "Lop " & i
aLop(i).row = STARTROW
'copy hàng tiêu đề từ sheet DSHS sang lớp i
For col = 1 To SOCOT
ActiveSheet.Cells(STARTROW - 1, col) = Sheets("DSTAM").Cells(STARTROW - 1, col)
Next col
Next i
'chọn sheet DSTAM để làm việc với nó
Sheets("DSTAM").Select
'tính số học sinh cho mỗi lớp
SoHS = TSHS \ n
HSDu = TSHS Mod n
row = STARTROW
'phân phối các học sinh giỏi nhất vào lớp n
i = 0
While i <>
'copy 1 học sinh từ sheet tạm sang lớp n
For col = 1 To SOCOT
Sheets(aLop(n).name).Cells(aLop(n).row, col) = Cells(row, col)
Next col
'cập nhật hàng cần thêm học sinh
aLop(n).row = aLop(n).row + 1
row = row + 1
'cập nhật số học sinh đã phân phối
i = i + 1
Wend
'nếu còn dư học sinh thì lấy thêm 1 học sinh nữa
If HSDu <> 0 Then
'copy 1 học sinh từ sheet tạm sang lớp n
For col = 1 To SOCOT
Sheets(aLop(n).name).Cells(aLop(n).row, col) = Cells(row, col)
Next col
'cập nhật hàng cần thêm học sinh
aLop(n).row = aLop(n).row + 1
End If
Set rg = Range("A" & row & ":Z" & (TSHS + STARTROW - 1))
rg.Select
'xếp danh sách học sinh còn lại theo trường
'mỗi trường xếp từ điểm cao -> thấp
Selection.Sort Key1:=Range(srtr), Order1:=xlAscending, Key2:=Range(srhl), Order2:=xlDescending, Header:=xlGuess, OrderCustom:=1, MatchCase:= False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 :=xlSortNormal
'gọi thủ tục Xeplop1t để xếp các học sinh còn lại
'vào n-1 lớp còn lại theo tiêu chuẩn 1
Xeplop1t n - 1, row
'xóa sheet tạm
Sheets("DSTAM").Select
ActiveWindow.SelectedSheets.Delete
End Sub