java怎么算优秀率_20181013xlVba计算优秀率及合格率

Sub 计算高一优秀合格率()

Dim Wb As Workbook

Dim Sht As Worksheet

Dim oSht As Worksheet

Dim dOs As Object 'OutStanding

Const SUBJECTS = "语文数学英语物理化学生物政治历史地理"

Set dOs = CreateObject("Scripting.Dictionary")

Set Wb = Application.ThisWorkbook

Set Sht = Wb.Worksheets("年级_本次成绩总表")

With Sht

EndRow = .Cells(.Cells.Rows.Count, 1).End(xlUp).Row

EndCol = .Cells(1, .Cells.Columns.Count).End(xlToLeft).Column

For j = 4 To EndCol

If InStr(SUBJECTS, .Cells(1, j).Text) > 0 Then

Subject = .Cells(1, j).Text

For i = 2 To EndRow

If .Cells(i, "Y").Value = "" Then

goal = .Cells(i, j).Value

Cls = .Cells(i, 3).Value

Key = Cls & ";" & Subject

If goal <> "" Then

If Not dOs.exists(Key) Then

If goal >= OsLine(Subject, 1) Then

os = 1

Else

os = 0

End If

If goal >= OsLine(Subject, 2) Then

pass = 1

Else

pass = 0

End If

dOs(Key) = Array(1, os, pass)

Else

Ar = dOs(Key)

Ar(0) = Ar(0) + 1

If goal >= OsLine(Subject, 1) Then Ar(1) = Ar(1) + 1

If goal >= OsLine(Subject, 2) Then Ar(2) = Ar(2) + 1

dOs(Key) = Ar

End If

End If

End If

Next i

End If

Next j

End With

'For Each OneKey In dOs.keys

'Ar = dOs(OneKey)

'Debug.Print OneKey; " "; Ar(0); " "; Ar(1); " "; Ar(2)

'Next

Set Sht = Wb.Worksheets("年级_各科离均率")

With Sht

StartRow = 60

ClassCount = 20

SubjectCount = 10

.Cells(StartRow + 1, 2).Resize(ClassCount, SubjectCount).ClearContents

For j = 2 To SubjectCount + 1

Subject = .Cells(StartRow, j).Value

For i = StartRow + 1 To StartRow + 20

Cls = .Cells(i, 1).Value

Key = Cls & ";" & Subject

If dOs.exists(Key) Then

Ar = dOs(Key)

.Cells(i, j).Value = Format(Ar(1) / Ar(0), "0.0%")

End If

Next i

Next j

StartRow = 84

ClassCount = 20

SubjectCount = 10

.Cells(StartRow + 1, 2).Resize(ClassCount, SubjectCount).ClearContents

For j = 2 To SubjectCount + 1

Subject = .Cells(StartRow, j).Value

For i = StartRow + 1 To StartRow + 20

Cls = .Cells(i, 1).Value

Key = Cls & ";" & Subject

If dOs.exists(Key) Then

Ar = dOs(Key)

.Cells(i, j).Value = Format(Ar(2) / Ar(0), "0.0%")

End If

Next i

Next j

End With

End Sub

Function OsLine(ByVal Subject As String, ByVal Level As Long) As Double 'Level 1优秀0合格

Select Case Subject

Case "语文", "数学", "英语"

If Level = 1 Then

OsLine = 120

Else

OsLine = 90

End If

Case Else

If Level = 1 Then

OsLine = 80

Else

OsLine = 60

End If

End Select

End Function