字典法计数

gwjkkkkk

参与一下。。。

凌飞云天

半百 发表于 2024-2-27 20:10
这样吗？

运算错误。如801班，优秀有十几人，但运算结果是1 人，其它班也是这种情况。

凌飞云天

chxw68 发表于 2024-2-27 20:22
修改的楼主代码。

非常好用，多谢啦!!☆⌒(*＾-゜)v

凌飞云天

chxw68 发表于 2024-2-27 20:22
修改的楼主代码。

非常好用，多谢啦!!☆⌒(*＾-゜)v

凌飞云天

半百 发表于 2024-2-27 20:10
这样吗？

依此代码，运算结果错误

凌飞云天

ykcbf1100 发表于 2024-2-27 21:07
代码供参考。。。

就是代码有些复杂

ykcbf1100

凌飞云天 发表于 2024-2-28 11:07
就是代码有些复杂

因为是C～G列全自动生成，加上格式设置，所以，代码会多些，但并不复杂。

准提部林

'分數段統計//by.准提部林
Sub Test_A1()
Dim Arr, Brr, xD, i&, V, T$, R&, C%, N&
Set xD = CreateObject("scripting.dictionary")
Arr = Range(Sheet1.[b1], Sheet1.[a65536].End(3))
ReDim Brr(1 To UBound(Arr), 1 To 5)
For i = 2 To UBound(Arr)
    T = Arr(i, 1): V = Arr(i, 2): R = xD(T)
    If R = 0 Then N = N + 1: R = N: xD(T) = R: Brr(R, 1) = T
    C = Switch(V >= 100, 2, V >= 90, 3, V >= 70, 4, V >= 50, 5, V = V, 0)
    If C > 0 Then Brr(R, C) = Brr(R, C) + 1
Next i
With Sheet1.[c2].Resize(N, 5)
     .Value = Brr
     .Sort Key1:=.Item(1), Order1:=xlAscending, Header:=xlNo
End With
End Sub

凌飞云天

gwjkkkkk 发表于 2024-2-27 21:15
Option Explicit
Sub TEST9()
    Dim ar, i&, j&, r&, dic As Object, vKey

最后一列数据计算错误，前几列都正确

yanglinzi

请参考，楼主的代码一修改