学生成绩按年级人数比例赋等级

hbszls

请教各位帮帮忙，谢谢！

yanglinzi

没看明白啥意思？

过客fppt

弄几个辅助列，分别算出排名，排名率，在根据排名率确定等级即可

cnmlgb9998

我理解 是 按成绩 降序排列，再依次取 前15%，35%，35%，13%，2% ，分别 赋值  ABCDE？？？？？？

hbszls

cnmlgb9998 发表于 2024-5-5 15:17
我理解 是 按成绩 降序排列，再依次取 前15%，35%，35%，13%，2% ，分别 赋值  ABCDE？？？？？？

是按全年级排序，之后根据百分比赋等级。

cnmlgb9998

hbszls 发表于 2024-5-5 16:24
是按全年级排序，之后根据百分比赋等级。

你能不能说清楚一点。你说的，没办法去理解 ！！！！！

cnmlgb9998

因为人数乘百分比后取整，有的会少一个人。这个BUG 不想去解决了。



你这排名太奇怪了，没你这样的。

grf1973

用JS做了一下。

ooluckydog

1. Option Explicit
   
2. Const ratio_a# = 15 / 100
   
3. Const ratio_b# = 50 / 100
   
4. Const ratio_c# = 85 / 100
   
5. Const ratio_d# = 98 / 100
   
6. 
   
7. 
   
8. Sub 成绩赋等级()
   
9.     Dim lastRow%, i%, j%, arr, subjects$(), subject
   
10.     Dim fields As Object, schools As Object
    
11.    
    
12.     Set fields = CreateObject("scripting.dictionary")
    
13.     Set schools = CreateObject("scripting.dictionary")
    
14.     With Sheets("原始成绩")
    
15.         lastRow = .Cells(Rows.Count, 1).End(xlUp).Row
    
16.         arr = .Range("a2:h" & lastRow)
    
17.         
    
18.         For i = 2 To UBound(arr)
    
19.             If Not schools.exists(arr(i, 1)) Then
    
20.                 Set schools(arr(i, 1)) = New Collection
    
21.                 schools(arr(i, 1)).Add i
    
22.             Else
    
23.                 schools(arr(i, 1)).Add i
    
24.             End If
    
25.         Next
    
26.         
    
27.         For j = 1 To UBound(arr, 2)
    
28.             fields(arr(1, j)) = j
    
29.         Next
    
30.     End With
    
31.    
    
32.     subjects = Split("语文|数学|英语|生物", "|")
    
33.     For Each subject In subjects
    
34.         Call 单科赋等级(arr, fields, subject, schools)
    
35.     Next
    
36.    
    
37.     With Sheets("成绩等级（效果）")
    
38.         .[a2].CurrentRegion.ClearContents
    
39.         .[a2].Resize(UBound(arr), UBound(arr, 2)) = arr
    
40.     End With
    
41.     MsgBox "完毕！"
    
42. End Sub
    
43. 
    
44. 
    
45. Sub 单科赋等级(ByRef arr, ByRef fields As Object, ByVal subject, ByRef schools As Object)
    
46.     Dim num_a%, num_b%, num_c%, num_d%, aList As Object, school, i%, score
    
47.    
    
48.     Set aList = CreateObject("system.collections.arraylist")
    
49.     For Each school In schools.keys
    
50.         For i = 1 To schools(school).Count
    
51.             score = arr(schools(school)(i), fields(subject))
    
52.             If score <> "缺考" Then aList.Add score
    
53.         Next
    
54.         aList.Sort
    
55.         aList.Reverse
    
56.         num_a = Round(aList.Count * ratio_a)
    
57.         num_b = Round(aList.Count * ratio_b)
    
58.         num_c = Round(aList.Count * ratio_c)
    
59.         num_d = Round(aList.Count * ratio_d)
    
60.         For i = 1 To schools(school).Count
    
61.             score = arr(schools(school)(i), fields(subject))
    
62.             If score <> "缺考" Then
    
63.                 Select Case score
    
64.                     Case Is >= aList(num_a - 1): arr(schools(school)(i), fields(subject)) = "A"
    
65.                     Case Is >= aList(num_b - 1): arr(schools(school)(i), fields(subject)) = "B"
    
66.                     Case Is >= aList(num_c - 1): arr(schools(school)(i), fields(subject)) = "C"
    
67.                     Case Is >= aList(num_d - 1): arr(schools(school)(i), fields(subject)) = "D"
    
68.                     Case Else: arr(schools(school)(i), fields(subject)) = "E"
    
69.                 End Select
    
70.             End If
    
71.         Next
    
72.         aList.Clear
    
73.     Next
    
74.     Set aList = Nothing
    
75. End Sub
    

复制代码

yynrzwh

一个学校就一个年级？你也没有年级列