这样的高难度成绩分析可能只有求助老师们了

辛玛

今年我新接手了区教学工作管理，需要对区各学校的成绩进行分析，为尽快完成好，求助各位老师帮助。
原始数据：1，三个成绩表，包括学校、班级、学生姓名、各科成绩。
                2，一个教师数据表，包括学校、班级、科目、任教老师姓名
分析：
一，求出各年级各科的及格分、优秀分、关爱分。
   1，科目及格分：年级科目排名第X名的分数。X=与考人数*60%.
   2，科目优秀分：年级科目排名第Y名的分数。y=与考人数*20%.
   3，科目关爱分：年级科目排名第Z名的分数。Z=与考人数*80%.
   4，总分关爱分：年级各科总分排名第Z名的分数。Z=与考人数*80%.

二，求出（各年级）(各班)(各科)的平均分、及格率、关爱率、三率合计，排名，任教老师
1，班级科目平均分=本班本科总分/全班人数
2，班级科目及格率=本班本科及格人数/全班人数*100%。
3，班级科目关爱率=本班本科关爱人数/全班人数*100%。
4，三率合计：平均分*0.4+及格率*0.4+关爱率
5，排名，根所三率合计对各科成绩排名。
6，插入本班本科目的任教老师姓名。
三，求出（各年级）（各班）的平均分、全科合格率、优秀率、关爱率、四率合计，排名。
1，班级平均分=全班各科成绩总分/全班人数/科目数
2，全科合格率=所有考试科目全部及格的人数/全班人数*100%
3，优秀率：七年级：语文、数学、英语三科均优秀的人数/全班人数*100%
                   八、九年级：语文、数学、英语、物理四科均优秀的人数/全班人数*100%
4，关爱率=本班总分关爱人数/全班人数*100%
5，四率合计：班级平均分*0.3+全科合格率*0.3+优秀率*0.2+关爱率
6，排名，根据四率合计进行排名。
四，求出（各校）（各年级）的平均分、全科合格率、优秀率、关爱率、四率合计，学校总成绩，学校排名。
1，年级平均分=年级各科成绩总分/年级总人数/科目数
2，全科合格率=所有考试科目年级全部及格的人数/年级总人数*100%
3，优秀率：七年级：语文、数学、英语三科均优秀的年级人数/年级总人数*100%
                   八、九年级：语文、数学、英语、物理四科均优秀的年级人数/年级总人数*100%
4，关爱率=年级关爱人数/年级总人数*100%
5，四率合计：年级平均分*0.3+全科合格率*0.3+优秀率*0.2+关爱率
6，学校总成绩：各年级的四率合计平均分。
7，学校排名，学校总成绩进行排名。
五，教师排名：

chxw68

整理了一下表格顺序。

f8b1987

光条件就写得一堆代码了，建议找专人写

caffish

我也觉得你这代码的工作量得找个人有偿服务了

xyxcc177

呼唤雷锋！

丸子不是小孩子

建议找有偿服务。。。

chxw68

写个最简单的各科三分统计，这个没有考虑学生缺考的问题。楼主的问题确实复杂，我算是抛个砖吧。

1. Sub test()
   
2.   Dim r%, i%
   
3.   Dim arr, brr
   
4.   Dim d As Object
   
5.   Application.ScreenUpdating = False
   
6.   Application.DisplayAlerts = False
   
7.   Set d = CreateObject("scripting.dictionary")
   
8.   For Each ws In Worksheets(Array("七年级", "八年级", "九年级"))
   
9.     With ws
   
10.       r = .Cells(.Rows.Count, 1).End(xlUp).Row
    
11.       c = .Cells(2, .Columns.Count).End(xlToLeft).Column
    
12.       arr = .Range("a2").Resize(r - 1, c)
    
13.       ReDim Preserve arr(1 To UBound(arr), 1 To UBound(arr, 2) + 1)
    
14.       arr(1, UBound(arr, 2)) = "全科"
    
15.       For i = 2 To UBound(arr)
    
16.         For j = 5 To UBound(arr, 2) - 1
    
17.           arr(i, j) = Val(arr(i, j))
    
18.           arr(i, UBound(arr, 2)) = arr(i, UBound(arr, 2)) + arr(i, j)
    
19.         Next
    
20.       Next
    
21.       ReDim brr(1 To 4, 1 To UBound(arr, 2) - 4)
    
22.       For j = 5 To UBound(arr, 2)
    
23.         brr(1, j - 4) = arr(1, j)
    
24.         crr = Application.Index(arr, 0, j)
    
25.         brr(2, j - 4) = Application.Large(Application.Index(arr, 0, j), Round((UBound(arr) - 1) * 0.6, 0))
    
26.         brr(3, j - 4) = Application.Large(Application.Index(arr, 0, j), Round((UBound(arr) - 1) * 0.2, 0))
    
27.         brr(4, j - 4) = Application.Large(Application.Index(arr, 0, j), Round((UBound(arr) - 1) * 0.8, 0))
    
28.       Next
    
29.       d(ws.Name) = brr
    
30.     End With
    
31.   Next
    
32.   On Error Resume Next
    
33.   Worksheets("各科三分").Delete
    
34.   On Error GoTo 0
    
35.   Set ws = Worksheets.Add(after:=Worksheets(Worksheets.Count))
    
36.   With ws
    
37.     .Name = "各科三分"
    
38.     With .Range("a1")
    
39.       .Value = "及格分、优秀分、关爱分取值"
    
40.       .Resize(1, 12).Merge
    
41.       With .Font
    
42.         .Name = "微软雅黑"
    
43.         .Size = 16
    
44.       End With
    
45.     End With
    
46.     i1 = 2
    
47.     For Each aa In d.keys
    
48.       brr = d(aa)
    
49.       .Cells(i1, 1).Resize(1, 2) = Array("年级", "项目")
    
50.       With .Cells(i1 + 1, 1)
    
51.         .Value = aa
    
52.         .Resize(3, 1).Merge
    
53.       End With
    
54.       .Cells(i1 + 1, 2).Resize(3, 1) = [{"及格分";"优秀分";"关爱分"}]
    
55.       .Cells(i1, 3).Resize(UBound(brr), UBound(brr, 2)) = brr
    
56.       With .Cells(i1, 1).Resize(4, 2 + UBound(brr, 2))
    
57.         .Borders.LineStyle = xlContinuous
    
58.         .BorderAround LineStyle:=xlContinuous, Weight:=xlMedium
    
59.       End With
    
60.       i1 = i1 + 4
    
61.     Next
    
62.     With .UsedRange
    
63.       .HorizontalAlignment = xlCenter
    
64.       .VerticalAlignment = xlCenter
    
65.     End With
    
66.   End With
    
67.   Application.ScreenUpdating = True
    
68.   MsgBox "各科三分计算完毕！"
    
69.   
    
70. End Sub
    

复制代码

chxw68

抛砖引玉吧。

辛玛

chxw68 发表于 2020-7-20 17:08
抛砖引玉吧。

辛苦chxw68老师了，

zpy2

一个教师数据表，包括学校、班级、科目、任教老师姓
这个最好取消合并单元格，做成一维表

辛玛

zpy2 发表于 2020-7-20 18:07
一个教师数据表，包括学校、班级、科目、任教老师姓
这个最好取消合并单元格，做成一维表

谢谢老师指教