请问，如何用VBA计算去掉5%人数之后的优秀率、及格率和平均分？

bzjwcws

如附件所示：

1、计算学生的优秀率、及格率和平均分；
2、计算去掉5%人数之后的优秀率、及格率和平均分，附件中有58人，去掉5%四舍五入后是3人，即计算前55名学生的优秀率、及格率和平均分；
3、90分为优秀，60分为及格；
非常感谢各位大佬的赐教!

chxw68

1. Sub test()
   
2.     Dim r%, i%
   
3.     Dim arr, brr
   
4.     Dim d As Object
   
5.     Set d = CreateObject("scripting.dictionary")
   
6.     With Worksheets("VBA")
   
7.         .Range("c3:c4,e3:e4,g3:g4").ClearContents
   
8.         .Range("c7:d9").ClearContents
   
9.         brr = .Range("a3:g4")
   
10.         crr = .Range("c7:d9")
    
11.         r = .Cells(.Rows.Count, 1).End(xlUp).Row
    
12.         arr = .Range("c10:d" & r)
    
13.         rs = UBound(arr) - Application.Round(UBound(arr) * 0.05, 0)
    
14.         For j = 1 To UBound(arr, 2)
    
15.             fs = Application.Large(Application.Index(arr, 0, j), rs)
    
16.             s = 0
    
17.             For i = 1 To UBound(arr)
    
18.                 If arr(i, j) >= 90 Then
    
19.                     brr(j, 3) = brr(j, 3) + 1
    
20.                 End If
    
21.                 If arr(i, j) >= 60 Then
    
22.                     brr(j, 5) = brr(j, 5) + 1
    
23.                 End If
    
24.                 brr(j, 7) = brr(j, 7) + arr(i, j)
    
25.                
    
26.                 If arr(i, j) >= fs Then
    
27.                     s = s + 1
    
28.                     If arr(i, j) >= 60 Then
    
29.                         crr(1, j) = crr(1, j) + 1
    
30.                     End If
    
31.                     If arr(i, j) >= 90 Then
    
32.                         crr(2, j) = crr(2, j) + 1
    
33.                     End If
    
34.                     crr(3, j) = crr(3, j) + arr(i, j)
    
35.                  End If
    
36.             Next
    
37.             crr(3, j) = crr(3, j) - (s - rs) * rs
    
38.         Next
    
39.         For i = 1 To 2
    
40.             For j = 3 To 7 Step 2
    
41.                 brr(i, j) = Application.Round(brr(i, j) / UBound(arr), 4)
    
42.             Next
    
43.         Next
    
44.         For i = 1 To 3
    
45.             For j = 1 To 2
    
46.                 crr(i, j) = Application.Round(crr(i, j) / rs, 4)
    
47.             Next
    
48.         Next
    
49.         .Range("a3:g4") = brr
    
50.         .Range("c7:d9") = crr
    
51.     End With
    
52. End Sub
    

复制代码

chxw68

表格设计得太花哨了。

chxw68

修改了一下统计表格式，这样便于扩充，比如再增加一门英语成绩，不需要修改代码就能直接使用，仅供楼主参考。

bzjwcws

chxw68 发表于 2022-12-6 21:28
表格设计得太花哨了。

很荣幸能得到您的赐教，我拜读过您不少精品回帖，受益匪浅！还想麻烦您一下，C9单元格还差0.05，请问是什么原因啊？

bzjwcws

chxw68 发表于 2022-12-6 21:48
修改了一下统计表格式，这样便于扩充，比如再增加一门英语成绩，不需要修改代码就能直接使用，仅供楼主参考 ...

这样扩充实用性太强了，非常感谢！真的很仰慕！

bzjwcws

chxw68 发表于 2022-12-6 21:48
修改了一下统计表格式，这样便于扩充，比如再增加一门英语成绩，不需要修改代码就能直接使用，仅供楼主参考 ...

测试了一下，添加英语后不能正确计算，不知道是不是我操作原因，还请大佬多指教！

chxw68

修改了5楼中存在的问题。

chxw68

修改了7楼指出的问题。

熊文来

chxw68 发表于 2022-12-6 21:27

好久没看到你在论坛里发声了。