较难的数据转换问题,求大神帮助。

ooluckydog

建一个简单的类模块存放转换设置

chxw68

增加了计算排名代码。

grf1973

很好奇，如果分数正好在下限(s0=s1)，那岂不是分母为0？

chxw68

grf1973 发表于 2024-4-8 09:36
很好奇，如果分数正好在下限(s0=s1)，那岂不是分母为0？

楼主提供的公式确实存在这个问题，对这个要加个判断，如果卷面分刚好等于卷面分范围下限，那么赋分就等于赋分范围下限。

grf1973

。。。。。。。。。。

grf1973

重新生成对照表，用分数作为行，用分数对应的s1,s2,t1,t2作为列。
这样可以对分数s0直接确定s1,s2,t1,t2。

grf1973

原对照表里分数段没有实现全覆盖，附件里修改了一下。

yynrzwh

'计算公式应该是 t0=(t2 * (s0 - s1) + t1 * (s2 - s0)) / (s2 - s1)
'应该不会出现分母为0 的情况?

Sub test()

Set d = CreateObject("scripting.dictionary")
Set d2 = CreateObject("scripting.dictionary")

ar = Sheets("设置").Range("a1").CurrentRegion
    For i = 2 To UBound(ar) Step 2
        For j = 3 To UBound(ar, 2)
            For x = ar(i + 1, j) To ar(i, j)
                S = ar(i, 1) & x
                d(S) = ar(1, j)
            Next
            
            d2(ar(i, 1) & ar(1, j)) = Array(ar(i + 1, j), ar(i, j))
        Next
    Next

'S0-卷面分,S1-卷面下限,S2-卷面上限,t1-转换下限,t2-转换上限
br = Sheets("数据源").UsedRange
    For i = 2 To UBound(br)
        For j = 6 To UBound(br, 2) Step 2
            s0 = br(i, j)
            If Len(s0) Then
                dj = d(br(1, j) & s0)
                S = d2(br(1, j) & dj)
                s1 = S(0): s2 = S(1)
                T = d2("转换分" & dj)
                t1 = T(0): t2 = T(1)
                zhf = (t2 * (s0 - s1) + t1 * (s2 - s0)) / (s2 - s1)
                br(i, j) = zhf
            End If
            
        Next
    Next
   
    '排名
    For i = 2 To UBound(br)
        For j = 7 To UBound(br, 2) Step 2
            If br(i, j - 1) <> "" Then
                c = Left(Cells(1, j - 1).Address(0, 0), 1)
                br(i, j) = "=rank(" & c & i & "," & c & ":" & c & ")"
            End If
        Next
    Next
   
    For j = 6 To UBound(br, 2) Step 2
        br(1, j) = "转换" & br(1, j)
    Next
   
With Sheets("转换分结果")
    .UsedRange = ""
    .Range("a1").Resize(UBound(br), UBound(br, 2)) = br
End With

Set d = Nothing
End Sub