学生成绩统计与分析(分享)

long826121

我感觉这个附件很好，分享给大家下，不是原创！仅学习参考用！
Sub MakeClassSheet()
    '将Excel设置成手动计算
    Application.Calculation = xlCalculationManual
    '自动排序
    shtGrade.Range("年级成绩").Sort Key1:=shtGrade.Range("A2"), Order1:=xlAscending, Header:= _
         xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
         SortMethod:=xlPinYin, DataOption1:=xlSortNormal
    '源数据表的当前行
    i = 2
    '目标数据表的当前行
    j = 1
    '只清除内容
    shtClass.Range("班级成绩").ClearContents
    '至源表的当前单元格为空即停止循环
    While (shtGrade.Cells(i, 2) <> "")
        '找到属于该班级的学生的成绩行
        If shtGrade.Cells(i, 2) = shtClass.Range("当前班级") Then
             '复制到目标表相应列
            shtClass.Cells(2 + j, 2) = shtGrade.Cells(i, 1)
            For k = 3 To 10
                shtClass.Cells(2 + j, k) = shtGrade.Cells(i, k)
            Next k
            '目标表当前行下移
            j = j + 1
        End If
        '源表当前行下移
        i = i + 1
    Wend
    '恢复成自动计算方式
    Application.Calculation = xlCalculationAutomatic
End Sub
Sub CopyTable()
    '出错处理(如果存在重名的工作表会出错,这时不予改名)
    On Error Resume Next
    '复制到成绩表之后
    shtClass.Copy , shtClass
    Sheets(4).Name = shtClass.Range("当前班级") & "班成绩"
    Sheets(4).Activate
    '删除新表中的三个控件
    ActiveSheet.Shapes(1).Select
    Selection.Delete
    ActiveSheet.Shapes(1).Select
    Selection.Delete
    ActiveSheet.Shapes(1).Select
    Selection.Delete
End Sub
Sub CopyTableAll()
    '倒序复制，生成的表为正序
    For i = shtStat.Range("班级数") To 1 Step -1
        shtClass.Range("当前班级") = i
        MakeClassSheet
        CopyTable
    Next
End Sub

ppp710715

学习了，谢谢楼主！

xtwrt

你真能能，呵呵……可惜我看不懂！

af715

科目怎么增加，再加几科吧

ypbnyn

学习了，谢谢楼主！

eikok

感谢楼主，学习一下

a8507024

不太懂代码
请指教啊

3836w

学校都无法改