一个非常实用的成绩管理系统 ___ VBA 学习的实例

sillysilly

感觉很不错的，用起来界面很好的说

lp3090

不错，虽然用不上，下载来学习一下。多谢楼主

jessen

thanks a lot

mnpking

谢谢楼主的精彩奉献

lcbnyn

下载来学习一下。多谢楼主

双飞叶

楼主了，能不能说一说修改人数的方法，这样就能让大家学以致用~~

双飞叶

下面是我用ALT+F11打开时，定义函数的内容：

Sub Auto_Open()
    Application.Calculation = xlManual
    Sheets("原数据").Select
   
   ' MsgBox "通过本系统将使你的工作更加轻松!", vbInformation, "欢迎使用成绩管理系统"
     Call dymc '定义名称函数
     Call hide
    UserForm1.Show
   

End Sub
Function Zm()
'定义函数 : 计算总分,班级排名,年级排名

Range("N3").Select
    ActiveCell.FormulaR1C1 = "=SUM(RC[-9]:RC[-1])"
    Selection.AutoFill Destination:=Range("OFFSET(原数据!$N$3,0,0,COUNTA(原数据!$A:$A)-2,1)"), Type:=xlFillDefault
    ActiveSheet.Calculate
    Range("O3").Select
    ActiveCell.FormulaR1C1 = "=SUMPRODUCT((班级=RC[-13])*(总分>RC[-1]))+1"
    Selection.AutoFill Destination:=Range("OFFSET(原数据!$O$3,0,0,COUNTA(原数据!$A:$A)-2,1)"), Type:=xlFillDefault
    Range("P3").Select
    ActiveCell.FormulaR1C1 = "=RANK(RC[-2],总分)"
    Selection.AutoFill Destination:=Range("OFFSET(原数据!$P$3,0,0,COUNTA(原数据!$A:$A)-2,1)"), Type:=xlFillDefault
    ActiveSheet.Calculate
    Range("OFFSET(原数据!$N$3,0,0,COUNTA(原数据!$A:$A)-2,3)").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
End Function
Function paixu()
'定义排序函数 : 使成绩按总分降序排列

   
    Call Quxiao_shaixuan
Range("OFFSET(原数据!$A$2,0,0,COUNTA(原数据!$A:$A)-1,COUNTA(原数据!$A$2:$BB$2))").Sort Key1:=Range("N3"), Order1:=xlDescending, Header:= _
        xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        SortMethod:=xlPinYin, DataOption1:=xlSortNormal
        
    Range("A3").Select
End Function

Function dymc()
'定义名称
ActiveWorkbook.Names.Add Name:="班级", RefersTo:="=原数据!$B$3:$B$3300"
ActiveWorkbook.Names.Add Name:="姓名", RefersTo:="=原数据!$C$3:$C$3300"
ActiveWorkbook.Names.Add Name:="保优", RefersTo:="=原数据!$D$3:$D$3300"
ActiveWorkbook.Names.Add Name:="语文", RefersTo:="=原数据!$E$3:$E$3300"
ActiveWorkbook.Names.Add Name:="数学", RefersTo:="=原数据!$F$3:$F$3300"
ActiveWorkbook.Names.Add Name:="英语", RefersTo:="=原数据!$G$3:$G$3300"
ActiveWorkbook.Names.Add Name:="物理", RefersTo:="=原数据!$H$3:$H$3300"
ActiveWorkbook.Names.Add Name:="化学", RefersTo:="=原数据!$I$3:$I$3300"
ActiveWorkbook.Names.Add Name:="生物", RefersTo:="=原数据!$J$3:$J$3300"
ActiveWorkbook.Names.Add Name:="政治", RefersTo:="=原数据!$K$3:$K$3300"
ActiveWorkbook.Names.Add Name:="历史", RefersTo:="=原数据!$L$3:$L$3300"
ActiveWorkbook.Names.Add Name:="地理", RefersTo:="=原数据!$M$3:$M$3300"
ActiveWorkbook.Names.Add Name:="总分", RefersTo:="=原数据!$N$3:$N$3300"
ActiveWorkbook.Names.Add Name:="班名", RefersTo:="=原数据!$O$3:$O$3300"
ActiveWorkbook.Names.Add Name:="年名", RefersTo:="=原数据!$P$3:$P$3300"
End Function

Function Quxiao_shaixuan()
If Worksheets("原数据").FilterMode = True Then
    'MsgBox "Filter mode is on"
    Selection.AutoFilter
     Range("B1").Select
    ActiveCell.FormulaR1C1 = _
        "=MID(CELL(""filename""),SEARCH(""["",CELL(""filename""))+1, SEARCH(""]"",CELL(""filename""))-SEARCH(""["",CELL(""filename""))-5)&""总成绩单"""

Else
End If
Range("A3").Select
End Function





Sub hide()
'
' 隐藏

'
    Range("D2").Select
    Selection.EntireColumn.Hidden = True
End Sub




Sub shijian()
If Hour(Now) > 22 Then
UserForm1.Label22 = Now & "  夜深了,请注意休息!"
  ElseIf Hour(Now) > 19 Then
  UserForm1.Label22 = Now & " 晚上好! "
   ElseIf Hour(Now) > 12 Then
  UserForm1.Label22 = Now & " 下午好! "
ElseIf Hour(Now) > 6 Then
UserForm1.Label22 = Now & " 上午好! "
ElseIf Hour(Now) > 4 Then
UserForm1.Label22 = Now & " 你来的好早啊! "
ElseIf Hour(Now) > 0 Then
UserForm1.Label22 = Now & " 你的精力真充沛!很晚了,注意休息! "
End If
'Application.OnTime Now + TimeValue("00:00:01"), "shijian"
End Sub

Function banjipaixu()
'Call Quxiao_shaixuan
Sheets("原数据").Select
Range("OFFSET(原数据!$A$2,0,0,COUNTA(原数据!$A:$A)-1,COUNTA(原数据!$A$2:$BB$2))").Sort Key1:=Range("b3"), Order1:=xlAscending, Header:= _
        xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        SortMethod:=xlPinYin, DataOption1:=xlSortNormal
        
        
   
End Function

要是增加或减少人数的话，是不是将  RefersTo:="=原数据!$B$3:$B$3300"   中的数列原数据!$B$3:$B$3300增加或者减少就OK了，还有没有其他地方要改动的呢？

hank2611

不错，只要该3300就可以了 。把它改成 总人数 + 2，

4701568

我说的是窗口的内容啊

4701568

打印其弹出窗口的内容啊，即点击“成绩管理”弹出窗口的内容啊？能不能实现啊？楼主！！！！！！要是能实现就好了啊！！！！！！！！