[已解决]等级赋值

心灵之舞

1、根据组别人数和名次给等级赋值。

规则：人数<=3,等级一、二、三各1，等级数等于名次，但是大写。 等级赋值.rar (7.06 KB, 下载次数: 7)

2014-4-20 00:50 上传

点击文件名下载附件

人数=4，取1个一等级，1个2等级，2个三等级。

人数=5,取1个一等级，2个2等级，2个三等级。

人数=6,取2个一等级，1个2等级，2个三等级。

请论坛的老师们帮助，谢谢！

最佳答案

月排行榜 / 总排行榜

那么的帅

2014-4-20 10:10

心灵之舞 发表于 2014-4-20 07:10
文件名次有点问题,谢谢老师,现已修改好!有很多组别和名次,请老师帮忙给个等级的VBA代码,谢谢!

323303-VBA-字典-等级赋值.rar (12.79 KB, 下载次数: 10)

2014-4-20 10:10 上传

点击文件名下载附件

跳转到最佳答案楼层

那么的帅

现有数据中，组别1 中，名次1 2个，名次2 到名次5 各1个，名次2 如何确定等级？
组别2 中，名次1 名次2 各2个，但只有1个一等奖，如何确定？
组别4 中，没有1 2 名，如何确定等级？

另，函数解决，还是 VBA代码解决？

心灵之舞

文件名次有点问题,谢谢老师,现已修改好!有很多组别和名次,请老师帮忙给个等级的VBA代码,谢谢! 等级赋值1.rar (8.38 KB, 下载次数: 3)

2014-4-20 07:08 上传

点击文件名下载附件

dsmch

1. Sub Macro1()
   
2. Dim arr, brr, d, d2, zf$, i&
   
3. Set d = CreateObject("scripting.dictionary")
   
4. Set d2 = CreateObject("scripting.dictionary")
   
5. arr = Range("c3:h" & Range("h65536").End(xlUp).Row)
   
6. ReDim brr(1 To UBound(arr), 1 To 1)
   
7. d2("4,1") = "一"
   
8. d2("4,2") = "二"
   
9. d2("4,3") = "三"
   
10. d2("4,4") = "三"
    
11. d2("5,1") = "一"
    
12. d2("5,2") = "二"
    
13. d2("5,3") = "二"
    
14. d2("5,4") = "三"
    
15. d2("5,5") = "三"
    
16. d2("6,1") = "一"
    
17. d2("6,2") = "一"
    
18. d2("6,3") = "二"
    
19. d2("6,4") = "三"
    
20. d2("6,5") = "三"
    
21. zf = "一二三"
    
22. For i = 1 To UBound(arr)
    
23.     d(arr(i, 6)) = d(arr(i, 6)) + 1
    
24. Next
    
25. For i = 1 To UBound(arr)
    
26.     If d(arr(i, 6)) <= 3 Then
    
27.         brr(i, 1) = Mid(zf, arr(i, 1), 1)
    
28.     Else
    
29.         brr(i, 1) = d2(d(arr(i, 6)) & "," & arr(i, 1))
    
30.     End If
    
31. Next
    
32. Range("b3").Resize(UBound(brr)) = brr
    
33. End Sub
    

复制代码

dsmch

………………

那么的帅

心灵之舞 发表于 2014-4-20 07:10
文件名次有点问题,谢谢老师,现已修改好!有很多组别和名次,请老师帮忙给个等级的VBA代码,谢谢!

323303-VBA-字典-等级赋值.rar (12.79 KB, 下载次数: 10)

2014-4-20 10:10 上传

点击文件名下载附件

心灵之舞

谢谢老师们在百忙中帮助解答，论坛里有你们的默默奉献，将会越来越好，再次感谢！