vba score

来源:互联网 发布:淘宝页面规范 编辑:程序博客网 时间:2024/05/18 09:06
Private Sub CommandButton1_Click()
'dim
Dim Subject As String
Dim StudentAll As Integer
Dim student As Integer
Dim i As Integer
Dim j As Integer
Dim item As Integer
Dim Worksheet As Worksheet
Dim totalscore As Integer
Dim rankline As Integer
Dim rank As Integer
Dim databeginline As Integer
Dim classtotalscore As Double
Dim classavgscore As Double
Dim highestscore As Double
Dim lowestscore As Double
Dim temp As Integer
Dim lastrank As Integer
Dim goodpercent As Double
Dim passpercent As Double
Dim head As Integer
Dim tail As Integer
Dim biaozhuncha As Double
Dim biaozhunchasum As Double






















' init


Set Worksheet = Worksheets("Sheet2")
StudentAll = 0
student = 0
totalscore = 0




'count StudentAll
    i = 4
    Do While Worksheet.Cells(i, 1) <> ""
        StudentAll = StudentAll + 1
        If Worksheet.Cells(i, 3) <> "*" Then
            student = student + 1
        End If
        i = i + 1
    Loop


'count totalscore
    i = 3
    Do While Worksheet.Cells(3, i) <> "" And Worksheet.Cells(3, i) < 60
        totalscore = totalscore + Worksheet.Cells(3, i)
        i = i + 1
    Loop
    Worksheet.Cells(3, i).Value = totalscore
    item = i - 3
    Worksheet.Cells(3 - 1, i).Value = "TotalScore"


    i = 4
    j = 3
    Do While i <= StudentAll + 3
        If Worksheet.Cells(i, 3).Value = "*" Then
            Worksheet.Cells(i, item + 3).Value = "*"
        Else
            j = 3
            Worksheet.Cells(i, item + 3).Value = totalscore
            Do While j <= item + 2
                If Worksheet.Cells(i, j).Value <> "" Then
                    Worksheet.Cells(i, item + 3).Value = Worksheet.Cells(i, item + 3).Value - Worksheet.Cells(i, j).Value
                End If
                j = j + 1
            Loop
         End If
        i = i + 1
     Loop


'count rank
    rankline = item + 4
    
    i = 4
    j = 4
    Do While i <= StudentAll + 3
        If Worksheet.Cells(i, 3).Value = "*" Then
            Worksheet.Cells(i, rankline).Value = "*"
        Else
            j = 4
            rank = 1
            Do While j <= StudentAll + 3
                If Worksheet.Cells(j, rankline - 1).Value = "*" Then
                    Worksheet.Cells(j, rankline).Value = "*"
                Else
                    If Worksheet.Cells(j, rankline - 1).Value > Worksheet.Cells(i, rankline - 1).Value Then
                        rank = rank + 1
                    Else
                    End If
                End If
                j = j + 1
            Loop
         End If
         Worksheet.Cells(i, rankline).Value = rank
        i = i + 1
     Loop
     Worksheet.Cells(2, rankline).Value = "rank"
     
'count databeginline *
 i = 1
 Do While Worksheet.Cells(i, 1).Value <> "*"
    i = i + 1
 Loop
 databeginline = i
  
     
'averge
i = 4
classtotalscore = 0
classavgscore = 0
Do While i <= StudentAll + 3
    If Worksheet.Cells(i, 3).Value = "*" Then
    Else
        classtotalscore = classtotalscore + Worksheet.Cells(i, rankline - 1).Value
    End If
    
    i = i + 1
Loop
classavgscore = classtotalscore / student


'count biaozhuncha
biaozhunchasum = 0
biaozhuncha = 0
i = 4
Do While i <= StudentAll + 3
    If Worksheet.Cells(i, 3).Value = "*" Then
    Else
        biaozhunchasum = biaozhunchasum + (Worksheet.Cells(i, rankline - 1).Value - classavgscore) * (Worksheet.Cells(i, rankline - 1).Value - classavgscore)
    End If
    
    i = i + 1
Loop
biaozhuncha = Sqr(biaozhunchasum / (student - 1))




'highestscore lowestscore
highestscore = 0
lowestscore = 0
temp = 1
i = 4
Do While i <= StudentAll + 3
    Select Case Worksheet.Cells(i, rankline).Value
    Case "*"
    Case "1"
        highestscore = Worksheet.Cells(i, rankline - 1).Value
    Case Is > temp
        temp = Worksheet.Cells(i, rankline).Value
        lowestscore = Worksheet.Cells(i, rankline - 1).Value
    End Select


    i = i + 1
Loop


'goodpercent passpercent
i = 4
goodpercent = 0
passpercent = 0
Do While i <= StudentAll + 3
    If Worksheet.Cells(i, 3).Value = "*" Then
    Else
        Select Case Worksheet.Cells(i, rankline - 1).Value
        Case Is >= 80
            goodpercent = goodpercent + 1
            passpercent = passpercent + 1
        Case Is >= 60
             passpercent = passpercent + 1
        End Select
    End If
    
    i = i + 1
Loop


'put data
Worksheet.Cells(databeginline + 2, 1).Value = StudentAll
Worksheet.Cells(databeginline + 2, 2).Value = classtotalscore
Worksheet.Cells(databeginline + 2, 3).Value = highestscore
Worksheet.Cells(databeginline + 2, 4).Value = CStr(goodpercent / student * 100) + "%"
Worksheet.Cells(databeginline + 2, 5).Value = student
Worksheet.Cells(databeginline + 2, 6).Value = classavgscore
Worksheet.Cells(databeginline + 2, 7).Value = lowestscore
Worksheet.Cells(databeginline + 2, 8).Value = CStr(passpercent / student * 100) + "%"


Worksheet.Cells(databeginline + 4, 1).Value = StudentAll - student
Worksheet.Cells(databeginline + 4, 2).Value = biaozhuncha
Worksheet.Cells(databeginline + 4, 3).Value = highestscore - lowestscore
Worksheet.Cells(databeginline + 4, 4).Value = biaozhuncha / classavgscore


'count 100-120 100 90-99.....
Worksheet.Cells(databeginline + 8, 2).Value = 0
Worksheet.Cells(databeginline + 8, 3).Value = 0
Worksheet.Cells(databeginline + 8, 4).Value = 0
Worksheet.Cells(databeginline + 8, 5).Value = 0
Worksheet.Cells(databeginline + 8, 6).Value = 0
Worksheet.Cells(databeginline + 8, 7).Value = 0
Worksheet.Cells(databeginline + 8, 8).Value = 0
Worksheet.Cells(databeginline + 8, 9).Value = 0
Worksheet.Cells(databeginline + 8, 10).Value = 0
Worksheet.Cells(databeginline + 8, 11).Value = 0


i = 4
Do While i <= StudentAll + 3
    If Worksheet.Cells(i, 3).Value = "*" Then
    Else
        Select Case Worksheet.Cells(i, rankline - 1).Value
        Case Is > 100
            Worksheet.Cells(databeginline + 8, 2).Value = Worksheet.Cells(databeginline + 8, 2).Value + 1
        Case 100
             Worksheet.Cells(databeginline + 8, 3).Value = Worksheet.Cells(databeginline + 8, 3).Value + 1
        Case Is > 90
             Worksheet.Cells(databeginline + 8, 4).Value = Worksheet.Cells(databeginline + 8, 4).Value + 1
        Case Is > 80
             Worksheet.Cells(databeginline + 8, 5).Value = Worksheet.Cells(databeginline + 8, 5).Value + 1
        Case Is > 70
             Worksheet.Cells(databeginline + 8, 6).Value = Worksheet.Cells(databeginline + 8, 6).Value + 1
        Case Is > 60
             Worksheet.Cells(databeginline + 8, 7).Value = Worksheet.Cells(databeginline + 8, 7).Value + 1
        Case Is > 50
             Worksheet.Cells(databeginline + 8, 8).Value = Worksheet.Cells(databeginline + 8, 8).Value + 1
        Case Is > 40
             Worksheet.Cells(databeginline + 8, 9).Value = Worksheet.Cells(databeginline + 8, 9).Value + 1
        Case Is > 30
             Worksheet.Cells(databeginline + 8, 10).Value = Worksheet.Cells(databeginline + 8, 10).Value + 1
        Case Is < 20
             Worksheet.Cells(databeginline + 8, 11).Value = Worksheet.Cells(databeginline + 8, 11).Value + 1
       
        End Select
    End If
    
    i = i + 1
Loop
Worksheet.Cells(databeginline + 9, 2).Value = CStr(Worksheet.Cells(databeginline + 8, 2).Value / student * 100) + "%"
Worksheet.Cells(databeginline + 9, 3).Value = CStr(Worksheet.Cells(databeginline + 8, 3).Value / student * 100) + "%"
Worksheet.Cells(databeginline + 9, 4).Value = CStr(Worksheet.Cells(databeginline + 8, 4).Value / student * 100) + "%"
Worksheet.Cells(databeginline + 9, 5).Value = CStr(Worksheet.Cells(databeginline + 8, 5).Value / student * 100) + "%"
Worksheet.Cells(databeginline + 9, 6).Value = CStr(Worksheet.Cells(databeginline + 8, 6).Value / student * 100) + "%"
Worksheet.Cells(databeginline + 9, 7).Value = CStr(Worksheet.Cells(databeginline + 8, 7).Value / student * 100) + "%"
Worksheet.Cells(databeginline + 9, 8).Value = CStr(Worksheet.Cells(databeginline + 8, 8).Value / student * 100) + "%"
Worksheet.Cells(databeginline + 9, 9).Value = CStr(Worksheet.Cells(databeginline + 8, 9).Value / student * 100) + "%"
Worksheet.Cells(databeginline + 9, 10).Value = CStr(Worksheet.Cells(databeginline + 8, 10).Value / student * 100) + "%"
Worksheet.Cells(databeginline + 9, 11).Value = CStr(Worksheet.Cells(databeginline + 8, 11).Value / student * 100) + "%"








'count 100-85 100 84-78.....
Worksheet.Cells(databeginline + 14, 2).Value = 0
Worksheet.Cells(databeginline + 14, 3).Value = 0
Worksheet.Cells(databeginline + 14, 4).Value = 0
Worksheet.Cells(databeginline + 14, 5).Value = 0


i = 4
Do While i <= StudentAll + 3
    If Worksheet.Cells(i, 3).Value = "*" Then
    Else
        Select Case Worksheet.Cells(i, rankline - 1).Value
        Case Is > 85
            Worksheet.Cells(databeginline + 14, 2).Value = Worksheet.Cells(databeginline + 14, 2).Value + 1
        Case Is > 78
             Worksheet.Cells(databeginline + 14, 3).Value = Worksheet.Cells(databeginline + 14, 3).Value + 1
        Case Is > 60
             Worksheet.Cells(databeginline + 14, 4).Value = Worksheet.Cells(databeginline + 14, 4).Value + 1
        Case Is < 60
             Worksheet.Cells(databeginline + 14, 5).Value = Worksheet.Cells(databeginline + 14, 5).Value + 1
       
        End Select
    End If
    
    i = i + 1
Loop
Worksheet.Cells(databeginline + 15, 2).Value = CStr(Worksheet.Cells(databeginline + 14, 2).Value / student * 100) + "%"
Worksheet.Cells(databeginline + 15, 3).Value = CStr(Worksheet.Cells(databeginline + 14, 3).Value / student * 100) + "%"
Worksheet.Cells(databeginline + 15, 4).Value = CStr(Worksheet.Cells(databeginline + 14, 4).Value / student * 100) + "%"
Worksheet.Cells(databeginline + 15, 5).Value = CStr(Worksheet.Cells(databeginline + 14, 5).Value / student * 100) + "%"


'top 5
If student < 5 Then
    MsgBox "if you want to know the top 5/last 5 ,You should input more then 5 score"
Else
    temp = 1
    head = 1
    Do While temp <= 5
        i = 4
        Do While i <= StudentAll + 3
            If Worksheet.Cells(i, rankline).Value = head Then
                Worksheet.Cells(databeginline + 18 + temp, 1).Value = head
                Worksheet.Cells(databeginline + 18 + temp, 2).Value = Worksheet.Cells(i, 2).Value
                Worksheet.Cells(databeginline + 18 + temp, 3).Value = Worksheet.Cells(i, rankline - 1).Value
            
                temp = temp + 1
                If temp > 5 Then
                    GoTo labeltop5end
                End If
            End If
            i = i + 1
        Loop
        head = head + 1
    Loop
End If


labeltop5end:


'last 5
If student < 5 Then
    MsgBox "if you want to know the top 5/last 5 ,You should input more then 5 score"
Else
    temp = 1
    tail = student
    Do While temp <= 5
        i = 4
        Do While i <= StudentAll + 3
            If Worksheet.Cells(i, rankline).Value = tail Then
                Worksheet.Cells(databeginline + 18 + temp, 5).Value = tail
                Worksheet.Cells(databeginline + 18 + temp, 6).Value = Worksheet.Cells(i, 2).Value
                Worksheet.Cells(databeginline + 18 + temp, 7).Value = Worksheet.Cells(i, rankline - 1).Value
            
                temp = temp + 1
                If temp > 5 Then
                    GoTo labellast5end
                End If
            End If
            i = i + 1
        Loop
        tail = tail - 1
    Loop
End If
labellast5end:


'every question score
i = 3


Do While i <= item + 2
    Worksheet.Cells(StudentAll + 4, i).Value = 0
    j = 4
    Do While j <= StudentAll + 3
        If Worksheet.Cells(j, i).Value <> "*" And Worksheet.Cells(j, i).Value <> "" Then
            Worksheet.Cells(StudentAll + 4, i).Value = Worksheet.Cells(StudentAll + 4, i).Value + Worksheet.Cells(j, i).Value
        End If
        j = j + 1
    Loop
     Worksheet.Cells(StudentAll + 5, i).Value = Worksheet.Cells(3, i).Value * student - Worksheet.Cells(StudentAll + 4, i).Value
     Worksheet.Cells(databeginline + 30, i - 1).Value = Worksheet.Cells(3, i).Value * student
     Worksheet.Cells(databeginline + 31, i - 1).Value = Worksheet.Cells(3, i).Value * student - Worksheet.Cells(StudentAll + 4, i).Value
     Worksheet.Cells(databeginline + 32, i - 1).Value = CStr(Format(Worksheet.Cells(databeginline + 31, i - 1).Value / Worksheet.Cells(databeginline + 30, i - 1).Value * 100, "0.00")) + "%"
     Worksheet.Cells(databeginline + 33, i - 1).Value = Worksheet.Cells(3, i).Value * 0.6
    i = i + 1
Loop


i = 3


Do While i <= item + 2
    Worksheet.Cells(databeginline + 34, i - 1).Value = 0
    Worksheet.Cells(databeginline + 35, i - 1).Value = "0%"
    j = 4
    Do While j <= StudentAll + 3
        If Worksheet.Cells(j, i).Value <> "*" And Worksheet.Cells(j, i).Value <> "" Then
            If Worksheet.Cells(3, i).Value - Worksheet.Cells(j, i).Value < Worksheet.Cells(3, i).Value * 0.6 Then
                Worksheet.Cells(databeginline + 34, i - 1).Value = Worksheet.Cells(databeginline + 34, i - 1).Value + 1
                Worksheet.Cells(databeginline + 35, i - 1).Value = CStr(Worksheet.Cells(databeginline + 34, i - 1).Value / student * 100) + "%"
            End If
        End If
        j = j + 1
    Loop
    i = i + 1
Loop


'support
i = 4
Do While i <= StudentAll + 3
    If Worksheet.Cells(i, 3).Value = "*" Then
    Else
      Worksheet.Cells(i, rankline + 1).Value = Format(classavgscore - ((classtotalscore - Worksheet.Cells(i, rankline - 1).Value) / (student - 1)), "0.00")
    End If
    
    i = i + 1
Loop


Worksheet.Cells(2, rankline + 1) = "support"




'''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''
Subject = Worksheets("Sheet2").Cells(1, 1).Value


MsgBox "success"






End Sub


Private Sub CommandButton2_Click()
'dim
Dim i As Integer
Dim j As Integer
'copy
     i = 1
     j = 1
    Do While i < 200
        j = 1
        Do While j < 50
            Worksheets("Sheet2").Cells(i, j).Value = Worksheets("Sheet1").Cells(i, j).Value
            j = j + 1
        Loop
        i = i + 1
    Loop




End Sub



''''''''''''''''''''''''''''''''







Sub clear()
'
' clear Macro
' clear sheet2
'


'
    Sheets("Sheet2").Select
    Cells.Select
    Range("L20").Activate
    Selection.ClearContents
    Range("P2").Select
    Selection.copy
    Cells.Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("A1").Select
    Sheets("Sheet1").Select
End Sub
Sub copystyle()
'
' copystyle Macro
' 儅僋儘婰榐擔 : 2011/11/4  儐乕僓乕柤 : huangyiqi
'


'
    Cells.Select
    Selection.copy
    Sheets("Sheet2").Select
    Cells.Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Sheets("Sheet1").Select
    Range("A1:K1").Select
End Sub

原创粉丝点击