上一页  1 2  

　　现将各个宏的代码列举如下：

　　⑴分班

　　Sub 分班()

Const studentno = 191 '学生人数 　Const zdno = 12 '字段数 　Dim zd$(zdno) '定义为12个字段的数组 　Dim a(studentno, zdno), stu(60, zdno) 　Dim nam$(studentno), bjname$(60) '定义一个存放全校学生名字及各班学生名字的数组 　Dim bj(studentno) '定义存放班级的一个数组 　'理科班工作表 　Sheets("高三理").Select 　For i = 2 To studentno 　　bj(i) = ActiveSheet.Cells(i, 1) 　　nam$(i) = ActiveSheet.Cells(i, 2) 　　For j = 3 To zdno 　　　a(i, j) = ActiveSheet.Cells(i, j) 　　Next j 　Next i 　'存放字段到数组中。 　For i = 1 To zdno 　　zd$(i) = ActiveSheet.Cells(1, i) 　Next i 　'先建立各个班级的工作表 　Sheets("高三理").Select 　Sheets("高三理").Copy After:=Sheets("分数段") 　Sheets("高三理 (2)").Select 　Sheets("高三理 (2)").Name = "33" 　For i = 2 To studentno 　　For j = 1 To zdno 　　　ActiveSheet.Cells(i, j) = Space$(1) 　　Next j 　Next i 　Range("a1").Select 　For i = 1 To zdno 　　ActiveSheet.Cells(1, i) = zd$(i) 　Next i 　'34到36班工作表的建立 　For i = 34 To 36 　　x$ = Mid$(Str(33), 2) 　　Sheets(x$).Select 　　Sheets(x$).Copy After:=Sheets("分数段") 　　Sheets(x$ + " (2)").Select 　　Sheets(x$ + " (2)").Name = Mid$(Str(i), 2) 　Next i 　'具体分班。 　For k = 33 To 36 　　bjrs = 0 　　x$ = Mid$(Str(k), 2) 　　no = k Mod 10 　　Sheets(x$).Select 　　For i = 2 To studentno 　　　If bj(i) = no Then 　　　　bjrs = bjrs + 1 　　　　bjname$(bjrs) = nam$(i) 　　　　For j = 3 To zdno 　　　　　stu(bjrs, j) = a(i, j) 　　　　Next j 　　　End If 　　Next i 　　For i = 2 To bjrs 　　　ActiveSheet.Cells(i, 1) = no 　　　ActiveSheet.Cells(i, 2) = bjname$(i) 　　　For j = 3 To zdno 　　　　ActiveSheet.Cells(i, j) = stu(i, j) 　　　Next j 　　Next i 　Next k End Sub

　　⑵总分

Const studentno = 190 　Const xknum = 6 　Const zdnum = 12 　Sheets("高三理").Select 　For i = 2 To studentno + 1 　　Sum = 0 　　For j = 1 To xknum 　　　Sum = Sum + ActiveSheet.Cells(i, j + 3) 　　Next j 　　ActiveSheet.Cells(i, zdnum-1) = Sum 　Next i End Sub

　　⑶平均分

Sub 平均分() 　Const studentno = 190 　Const xknum = 6 　Dim fs(studentno, xknum), pjf3(4, 6), bjrs(4), qxpjf(6) 　Dim bj(studentno) 　Sheets("高三理").Select 　'以下程序段用于求全校平均分 　For i = 1 To studentno 　　bj(i) = ActiveSheet.Cells(i + 1, 1) 　　For j = 1 To xknum 　　　fs(i, j) = ActiveSheet.Cells(i + 1, j + 3) 　　Next j 　Next i 　For i = 1 To xknum 　　Sum = 0 　　For j = 1 To studentno 　　　Sum = Sum + fs(j, i) 　　Next j 　　qxpjf(i) = Sum / (j - 1) 　Next i 　'以下程序段用于求各班平均分 　For j = 1 To 4 　　For i = 1 To studentno 　　　If bj(i) = j + 2 Then 　　　　bjrs(j) = bjrs(j) + 1 　　　　For k = 1 To xknum 　　　　　pjf3(j, k) = pjf3(j, k) + fs(i, k) 　　　　Next k 　　　End If 　　Next i 　Next j 　For j = 1 To 4 　　For i = 1 To 6 　　　pjf3(j, i) = pjf3(j, i) / bjrs(j) 　　Next i 　Next j 　'写入各班各科平均分 　Sheets("平均分").Select 　For i = 1 To 4 　　For j = 1 To 6 　　　ActiveSheet.Cells(i + 2, j + 1) = pjf3(i, j) 　　Next j 　Next i 　'写入全校各科平均分 　i = 7 　For j = 1 To 6 　　ActiveSheet.Cells(i, j + 1) = qxpjf(j) 　Next j End Sub

⑷分数段

Sub 分数段() 　Const max = 600 　Const min = 390 　Const studentno = 190 　Const bjnum = 4 　Const fsdnum = 22 　Dim bjfsd(bjnum, fsdnum), zf(studentno, 2) 　Sheets("高三理").Select 　For i = 1 To studentno 　　zf(i, 1) = ActiveSheet.Cells(i + 1, 1) '存放班级 　　zf(i, 2) = ActiveSheet.Cells(i + 1, 11) '存放总分 　Next i 　For i = 1 To studentno 　　For j = 1 To 4 '3---6班共4个班级 　　　If zf(i, 1) = j + 2 Then 　　　　For k = max To min Step -10 　　　　　low = Int((max + 10 - k) / 10) 　　　　　If zf(i, 2) > k Then bjfsd(j, low) = bjfsd(j, low) + 1 　　　　Next k 　　　End If 　　Next j 　Next i 　Sheets("sheet3").Select 　For i = 3 To 6 　　For k = 1 To fsdnum 　　　ActiveSheet.Cells(i, k + 1) = bjfsd(i - 2, k) 　　Next k 　Next i 　Range("M3:W6").Select 　Selection.Cut 　ActiveWindow.LargeScroll ToRight:=-1 　Range("B8").Select 　ActiveSheet.Paste End Sub

　　⑸ 删除

Sub 删除() 　　Sheets("33").Select 　　ActiveWindow.SelectedSheets.Delete 　　Sheets("34").Select 　　ActiveWindow.SelectedSheets.Delete 　　Sheets("35").Select 　　ActiveWindow.SelectedSheets.Delete 　　Sheets("36").Select 　　ActiveWindow.SelectedSheets.Delete End Sub

⑹以下是本程序的界面及各个宏运行的结果

上一页  1 2