新高考等级赋分计算求助？

wangweihebtu · 发表于 2019-4-24 10:46

本帖最后由 wangweihebtu 于 2019-4-26 18:06 编辑

新高考，等级赋分：我试着写了写，我整的数组公式，效率特别低，而且还得多情况，分着能搞定，合在一起搞不定，求助!谢谢！
本来用数组公式，效率太低了，然后换了个思路，自己解决了，感谢大家的帮助，谢谢！

第二个附件是我自己解决的，发上来供参考。但是和别人做出来的不一样，不知道是哪里出了问题

chxw68 · 发表于 2019-4-24 11:27

Sub test()
Dim r%, i%
Dim arr, brr
Dim d As Object
Set d = CreateObject("scripting.dictionary")
With Worksheets("sheet1")
r = .Cells(.Rows.Count, 1).End(xlUp).Row
arr = .Range("a2:b" & r)
For i = 1 To UBound(arr)
If Not d.exists(arr(i, 2)) Then
ReDim brr(1 To 2)
brr(1) = arr(i, 1)
brr(2) = arr(i, 1)
Else
brr = d(arr(i, 2))
If brr(1) < arr(i, 1) Then
brr(1) = arr(i, 1)
End If
If brr(2) > arr(i, 1) Then
brr(2) = arr(i, 1)
End If
End If
d(arr(i, 2)) = brr
Next
.Range("f3:j4").ClearContents
arr = .Range("f2:j4")
For j = 1 To UBound(arr, 2)
If d.exists(arr(1, j)) Then
brr = d(arr(1, j))
arr(2, j) = brr(1)
arr(3, j) = brr(2)
End If
Next
.Range("f2:j4") = arr
End With
End Sub

复制代码

chxw68 · 发表于 2019-4-24 11:28

详见附件。

wangweihebtu · 发表于 2019-4-24 13:04

chxw68 发表于 2019-4-24 11:28
详见附件。

十分感谢版主，呜呜，我表达有误，我要的是把英语根据等级赋分，麻烦您给看看

qingc0221 · 发表于 2019-4-24 13:17

T=(T1+T1)*(Y2-Y)/(Y2-Y1)

zopey · 发表于 2019-4-24 17:08

序号辅助列，用于排序后恢复原样。

等级转换分.zip (44.14 KB, 下载次数: 502)

zopey · 发表于 2019-4-24 17:12

附件中单元格 [J5]=69 笔误，请改为 55。

wangweihebtu · 发表于 2019-4-24 17:33

zopey 发表于 2019-4-24 17:08
序号辅助列，用于排序后恢复原样。

我转换了个思路，然后用公式完成了，感谢！

wangweihebtu · 发表于 2019-4-24 17:39

qingc0221 发表于 2019-4-24 13:17
T=(T1+T1)*(Y2-Y)/(Y2-Y1)

感谢！自己解决了

wangweihebtu · 发表于 2019-4-26 17:51

本帖最后由 wangweihebtu 于 2019-4-26 17:57 编辑

zopey 发表于 2019-4-24 17:08
序号辅助列，用于排序后恢复原样。

老兄，麻烦个问题：您计算的结果和我计算的结果有的重合不了，我也不知道我在哪里有问题，麻烦给看看，谢谢！再就是您看看如果有学生缺考，能不能不参与运算，谢谢！

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

[求助] 新高考等级赋分计算求助？

评分

评分