求助各位大神，教师积分计算

xj123321 · 发表于 2024-6-22 18:35

chxw68 发表于 2024-6-22 18:25
修改好了。

完美，再次感谢禇老师！！！

cai2532 · 发表于 2024-6-22 19:13

留下脚印学习了。

wang-way · 发表于 2024-6-22 20:09

简单说下步骤: 字典记录学校-科目-教师的全部分数，求平均，存入学校-科目字典用于排名，同时记录教师的人数。最后计算排名，输出积分，排名等信息

wang-way · 发表于 2024-6-22 22:58

是这样的不

wang-way · 发表于 2024-6-23 02:31

类设计

Cteacher类

Public info As Object
Private Sub Class_Initialize()
Set info = CreateObject("Scripting.Dictionary")
info("序号") = 0
info("学校") = ""
info("姓名") = ""
info("任教科目数") = 0
info("总积分") = 0
Set info("任教信息") = CreateObject("Scripting.Dictionary")
End Sub
Private Sub Class_Terminate()
Set info = Nothing
End Sub

复制代码

Csubject类

Public info As Object
Private Sub Class_Initialize()
Set info = CreateObject("Scripting.Dictionary")
info("年级") = 0
info("科目") = ""
info("排名") = 0
info("积分") = 0
info("输出序号") = 0
info("任教班级数") = 0
info("任教班级分数") = "" '串接
info("任教班级均分") = 0
info("同级同科教师数量") = 0
info("同级同科教师均分") = "" '串接
End Sub
Public Sub GetAverage()
info("任教班级均分") = Round(Application.Evaluate(info("任教班级分数")) / info("任教班级数"), 2)
End Sub
Public Sub GetScore()
'积分计算
info("积分") = Round((info("同级同科教师数量") - info("排名") + 1) / info("同级同科教师数量") * 6, 2)
End Sub
Public Sub GetRank()
'Debug.Print info("任教班级均分")
xxx = Split(info("同级同科教师均分"), "+")
'Stop
info("排名") = CustomRank(Round(Val(info("任教班级均分")), 2), Split(info("同级同科教师均分"), "+"))
End Sub
Private Function CustomRank(ByVal n As Variant, ByVal ar As Variant) As Integer
Set d = CreateObject("Scripting.Dictionary")
For Each a In ar
k = Round(Val(a), 2)
d(k) = d(k) + 1
Next
For Each k In d.keys
If k > n Then
Count = Count + d(k)
End If
Next k
CustomRank = Count + 1
End Function
Private Sub Class_Terminate()
Set info = Nothing
End Sub

复制代码

模块代码

Public Sub 又长又臭啊2()
Dim d, d2
Set d = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary") 'array(人数，均分字符)
Dim wb As Workbook, sht As Worksheet
Dim t As cTeacher
Dim s As cSubject
Set wb = Application.ThisWorkbook
Set sht = wb.Worksheets("数据")
With sht
eRow = .Cells.Find("*", .Cells(1, 1), xlValues, xlWhole, xlByRows, xlPrevious).Row
ecol = .Cells(4, .Columns.Count).End(xlToLeft).Column
For j = 5 To ecol
If .Cells(3, j).Value <> "" Then
sbj = .Cells(3, j).Value
For i = 5 To eRow
If .Cells(i, 1).Value <> "" Then sch = .Cells(i, 1).Value
If .Cells(i, j).Value <> "" Then
tch = .Cells(i, j).Value
gra = .Cells(i, 2).Value
key1 = gra & sbj
If Not d2.Exists(key1) Then
d2(key1) = Array(1, 0, "|" & key1 & tch & "|")
Else
ar = d2(key1)
If InStr(ar(2), "|" & key1 & tch & "|") = 0 Then
ar(0) = ar(0) + 1
ar(2) = ar(2) & "|" & key1 & tch & "|"
End If
d2(key1) = ar
End If
If Not d.Exists(tch) Then
Set t = New cTeacher
t.info("学校") = sch
t.info("姓名") = tch
t.info("序号") = d.Count + 1
Set s = New cSubject
s.info("年级") = gra
s.info("科目") = sbj
s.info("任教班级数") = 1
s.info("任教班级分数") = .Cells(i, j + 1).Value
Set t.info("任教信息")(key1) = s
Set d(tch) = t
'做一系列判断
Else
Set t = d(tch) '取出老师
If Not t.info("任教信息").Exists(key1) Then
Set s = New cSubject
s.info("年级") = gra
s.info("科目") = sbj
s.info("任教班级数") = 1
s.info("任教班级分数") = .Cells(i, j + 1).Value
Set t.info("任教信息")(key1) = s
Else
Set s = t.info("任教信息")(key1)
s.info("任教班级数") = s.info("任教班级数") + 1
s.info("任教班级分数") = s.info("任教班级分数") & "+" & .Cells(i, j + 1).Value
Set t.info("任教信息")(key1) = s
End If
Set d(tch) = t
End If
End If
Next i
End If
Next j
End With
'Stop
For Each tch In d
Set t = d(tch)
t.info("任教科目数") = t.info("任教信息").Count
For Each sb In t.info("任教信息")
Set s = t.info("任教信息")(sb)
s.info("同级同科教师数量") = d2(sb)(0)
s.GetAverage
ar = d2(sb)
ar(1) = ar(1) & "+" & s.info("任教班级均分") '均分送入公共字典
d2(sb) = ar
'Set t.info("任教信息")(sb) = s
Next sb
'Set d(tch) = t
Next tch
For Each tch In d
Set t = d(tch)
mysum = 0
For Each sb In t.info("任教信息")
Set s = t.info("任教信息")(sb)
ar = d2(sb)
s.info("同级同科教师均分") = ar(1)
s.GetRank
s.GetScore
mysum = mysum + s.info("积分")
Next sb
t.info("总积分") = mysum / t.info("任教科目数")
Next tch
'------------------------------------------------------------输出结果
Set sht = wb.Worksheets("结果")
With sht
.UsedRange.Offset(3).Clear
r = 3
For Each tch In d
Set t = d(tch)
For Each sb In t.info("任教信息")
Set s = t.info("任教信息")(sb)
t.info("输出序号") = t.info("输出序号") + 1
If t.info("输出序号") = 1 Then
r = r + 1 '新起一行
'左侧输出
sht.Cells(r, 1).Value = t.info("序号")
sht.Cells(r, 2).Value = t.info("学校")
sht.Cells(r, 3).Value = t.info("姓名")
End If
c = 3 + (t.info("输出序号") - 1) * 5 + 1
sht.Cells(r, c).Value = s.info("年级")
sht.Cells(r, c + 1).Value = s.info("科目")
sht.Cells(r, c + 2).Value = s.info("同级同科教师数量")
sht.Cells(r, c + 3).Value = s.info("排名")
sht.Cells(r, c + 4).Value = s.info("积分")
Next sb
sht.Cells(r, 24).Value = t.info("总积分")
Next tch
With .Range("a3").CurrentRegion
.Borders.LineStyle = 1
.HorizontalAlignment = 3
End With
End With
End Sub

复制代码

效果

xj123321 · 发表于 2024-6-23 16:24

wang-way 发表于 2024-6-23 02:31
类设计

Cteacher类

虽然是看不懂，但还是感谢大师的帮助。

sunya_0529 · 发表于 2024-6-24 12:20

WPS里的JSA练习一下——

微信截图_20240624121740.png

		自动登录	找回密码
密码			免费注册

[已解决] 求助各位大神，教师积分计算

评分

评分

评分