成绩分数转等级

hbszls · 发表于 2024-5-10 08:40

说明：大于等于“优秀”分数的，赋值“优秀”
大于等于“良好”分数且小于“优秀”分数的，赋值“良好”
大于等于“合格”分数且小于“良好”分数的，赋值“合格”
小于“合格”分数的，赋值“待合格“

恳请熟悉的大师们帮忙写下，谢谢！

chxw68 · 发表于 2024-5-10 09:01

参与一下。

沈默00 · 发表于 2024-5-10 09:29

沈默00 · 发表于 2024-5-10 09:31

D2=XLOOKUP(原始成绩!E3,参数设置!B:B,参数设置!$A:$A,"待合格",-1) 右拉8列，下拉
L2=XLOOKUP(SUM(原始成绩!E3:L3),参数设置!J:J,参数设置!$A:$A,"待合格",-1) 下拉

EHGOOD · 发表于 2024-5-10 09:38

参与一下。

Enocheasty · 发表于 2024-5-10 09:50

沈默00 发表于 2024-5-10 09:31
D2=XLOOKUP(原始成绩!E3,参数设置!B:B,参数设置!$A:$A,"待合格",-1) 右拉8列，下拉
L2=XLOOKUP(SUM(原始 ...

其实我就想说，公式都可以决绝的，为啥一定要用VBA。不过大佬们也是很热心。

cnmlgb9998 · 发表于 2024-5-10 09:50

楼主的模拟结果有误。

PQ 解决方案！！！！！！！！！！！！！！！！！！！！！！！！！！

cnmlgb9998 · 发表于 2024-5-10 09:53

自学PQ 四个月，感觉这种题目用PQ 解，不要太香。。。。。。。。。。。。。。。。。。

EHGOOD · 发表于 2024-5-10 10:05

本帖最后由 EHGOOD 于 2024-5-10 10:10 编辑

题目虽简单，但读题要仔细。

baofa2 · 发表于 2024-5-10 10:15

Sub test0()
Dim data, para, dict As Object
Dim i As Long, j As Long, col As Long, pos As Long
Set dict = CreateObject("Scripting.Dictionary")
para = Worksheets("参数设置").Range("A1").CurrentRegion.Value
para(6, 1) = "待合格"
For j = 2 To UBound(para, 2)
dict.Add para(1, j), j
Next
With Worksheets("原始成绩").Range("A1").CurrentRegion
data = Range(.Cells(1), .Offset(, 1)).Value
End With
data(1, 1) = "质量监测成绩等级"
data(2, 3) = data(2, 4)
data(2, UBound(data, 2)) = "总分"
For j = 5 To UBound(data, 2)
data(2, j - 1) = data(2, j)
col = dict(data(2, j - 1))
For i = 3 To UBound(data)
Select Case Val(data(i, j))
Case Is >= para(3, col)
pos = 3
Case Is >= para(4, col)
pos = 4
Case Is >= para(5, col)
pos = 5
Case Else
pos = 6
End Select
If j = 5 Then data(i, 3) = data(i, 4)
data(i, j - 1) = para(pos, 1)
If j < UBound(data, 2) Then data(i, UBound(data, 2)) = data(i, UBound(data, 2)) + Val(data(i, j))
Next
Next
With Worksheets("成绩等级(结果)").Range("A1")
.CurrentRegion.ClearContents
.Resize(UBound(data), UBound(data, 2) - 1) = data
End With
Set dict = Nothing
Beep
End Sub

复制代码

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

[求助] 成绩分数转等级