[已解决]如何用vba计算各班各科按各班人数92%计算平均成绩

fanyixiao123

如何用vba计算各班各科按各班人数92%计算平均成绩，在线期待。。。

最佳答案

月排行榜 / 总排行榜

dsmch

2014-4-15 22:48

1. Sub Macro1()
   
2. Dim arr, brr, d, d2, rng As Range, i&
   
3. Set d = CreateObject("scripting.dictionary")
   
4. Set d2 = CreateObject("scripting.dictionary")
   
5. arr = Range("a1").CurrentRegion
   
6. For i = 2 To UBound(arr)
   
7.     d(arr(i, 3)) = d(arr(i, 3)) + 1
   
8.     d2(arr(i, 3)) = d2(arr(i, 3)) & " " & i
   
9. Next
   
10. ReDim brr(1 To d.Count, 1 To 11)
    
11. a = d.keys: b = d.items: b2 = d2.items
    
12. For i = 0 To d.Count - 1
    
13.     brr(i + 1, 1) = a(i)
    
14.     n = Int(b(i) * 0.92)
    
15.     x = Split(b2(i))
    
16.     y1 = Val(x(1)): y2 = Val(x(UBound(x)))
    
17.     For j = 4 To 13
    
18.         Set rng = Range(Cells(y1, j), Cells(y2, j))
    
19.         s = 0
    
20.         For k = 1 To n
    
21.             s = s + Application.Large(rng, k)
    
22.         Next
    
23.         brr(i + 1, j - 2) = s / n
    
24.     Next
    
25. Next
    
26. Range("o18").Resize(UBound(brr), 11) = brr
    
27. End Sub
    

复制代码

跳转到最佳答案楼层

fanyixiao123

各班各科成绩按各班人数的92%计算   例如：1班有50人，50*0.92=46人就是参评人数，50个人的语文成绩从高到低排列，只截取46人的语文成绩（从高到低），依次计算数学、英语等。。

fanyixiao123

fanyixiao123 发表于 2014-4-15 19:47
各班各科成绩按各班人数的92%计算   例如：1班有50人，50*0.92=46人就是参评人数，50个人的语文成绩从高到低 ...

各班各科成绩按各班人数的92%计算   例如：1班有50人，50*0.92=46人就是参评人数，50个人的语文成绩从高到低 ...

fanyixiao123

fanyixiao123 发表于 2014-4-15 19:54
各班各科成绩按各班人数的92%计算   例如：1班有50人，50*0.92=46人就是参评人数，50个人的语文成绩从高到 ...

有答案了吗？老哥

dsmch

1. Sub Macro1()
   
2. Dim arr, brr, d, d2, rng As Range, i&
   
3. Set d = CreateObject("scripting.dictionary")
   
4. Set d2 = CreateObject("scripting.dictionary")
   
5. arr = Range("a1").CurrentRegion
   
6. For i = 2 To UBound(arr)
   
7.     d(arr(i, 3)) = d(arr(i, 3)) + 1
   
8.     d2(arr(i, 3)) = d2(arr(i, 3)) & " " & i
   
9. Next
   
10. ReDim brr(1 To d.Count, 1 To 11)
    
11. a = d.keys: b = d.items: b2 = d2.items
    
12. For i = 0 To d.Count - 1
    
13.     brr(i + 1, 1) = a(i)
    
14.     n = Int(b(i) * 0.92)
    
15.     x = Split(b2(i))
    
16.     y1 = Val(x(1)): y2 = Val(x(UBound(x)))
    
17.     For j = 4 To 13
    
18.         Set rng = Range(Cells(y1, j), Cells(y2, j))
    
19.         s = 0
    
20.         For k = 1 To n
    
21.             s = s + Application.Large(rng, k)
    
22.         Next
    
23.         brr(i + 1, j - 2) = s / n
    
24.     Next
    
25. Next
    
26. Range("o18").Resize(UBound(brr), 11) = brr
    
27. End Sub
    

复制代码

dsmch

………………

fanyixiao123

辛苦了，师傅！ 大好人一个啊！

fanyixiao123

dsmch 发表于 2014-4-15 22:48

左边成绩数据改变后，后边班级顺序错乱，成绩计算出错，麻烦看下

fanyixiao123

dsmch 发表于 2014-4-15 22:49
………………

左边成绩数据改变后，后边班级顺序错乱，成绩计算出错，麻烦修改下，我想以后只改变成绩数据一键生成后边平均分（另外能否增添个清除数据按钮）

fanyixiao123

dsmch 发表于 2014-4-15 22:49
………………

我重新发帖了，师傅帮我再看下。在线等待。。。。