[已解决]请教高手用VBA代码实现总分年级排名和班级排名

wjp023

我想实现在年级成绩表内同时进行年级排名和班级排名,曾试着用用VBA向单元格内输入公式然后复制,可是文件共享状态下进行公式输入复制不能顺利完成,显示错误。由于人数不固定，共享状态又能都查看年级班级排名。咋办？请教高手,如何用用VBA代码实现总分年级排名和班级排名?

最佳答案

月排行榜 / 总排行榜

grf1973

2015-11-9 11:10

1. Sub tt()
   
2.     Dim Bigrng As Range
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     arr = Range("a1:i" & [a65536].End(3).Row)
   
5.     For i = 5 To UBound(arr)
   
6.         bj = arr(i, 1)
   
7.         If Not d.exists(bj) Then
   
8.             Set d(bj) = Cells(i, 7)
   
9.         Else
   
10.             Set d(bj) = Union(d(bj), Cells(i, 7))
    
11.         End If
    
12.     Next
    
13.     Set Bigrng = Range("g5:g" & [g65536].End(3).Row)
    
14.     For i = 5 To UBound(arr)
    
15.         bj = arr(i, 1)
    
16.         arr(i, 8) = Application.WorksheetFunction.Rank(arr(i, 7), Bigrng)
    
17.         If d.exists(bj) Then arr(i, 9) = Application.WorksheetFunction.Rank(arr(i, 7), d(bj))
    
18.     Next
    
19.    
    
20.     [h1].Resize(UBound(arr)) = Application.Index(arr, , 8)
    
21.     [i1].Resize(UBound(arr)) = Application.Index(arr, , 9)
    
22. End Sub
    

复制代码

跳转到最佳答案楼层

wjp023

求助

grf1973

1. Sub tt()
   
2.     Dim Bigrng As Range
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     arr = Range("a1:i" & [a65536].End(3).Row)
   
5.     For i = 5 To UBound(arr)
   
6.         bj = arr(i, 1)
   
7.         If Not d.exists(bj) Then
   
8.             Set d(bj) = Cells(i, 7)
   
9.         Else
   
10.             Set d(bj) = Union(d(bj), Cells(i, 7))
    
11.         End If
    
12.     Next
    
13.     Set Bigrng = Range("g5:g" & [g65536].End(3).Row)
    
14.     For i = 5 To UBound(arr)
    
15.         bj = arr(i, 1)
    
16.         arr(i, 8) = Application.WorksheetFunction.Rank(arr(i, 7), Bigrng)
    
17.         If d.exists(bj) Then arr(i, 9) = Application.WorksheetFunction.Rank(arr(i, 7), d(bj))
    
18.     Next
    
19.    
    
20.     [h1].Resize(UBound(arr)) = Application.Index(arr, , 8)
    
21.     [i1].Resize(UBound(arr)) = Application.Index(arr, , 9)
    
22. End Sub
    

复制代码

wjp023

grf1973 发表于 2015-11-9 11:10

谢谢你，前几天忙，没看到。你的代码果然有效。你真是高手。不过，我没看懂你的思路呢。

安全网

grf1973 发表于 2015-11-9 11:10

汇总数据栏和排名列能否动态选择，加入这样的    Set MYCELL = Application.InputBox(prompt:="请选择需要排名的列（点击标题栏）", Type:=8)，汇总数据由1-12月单列的汇总，也有全年的汇总

grf1973

可选择排序列。

安全网

grf1973 发表于 2015-11-16 12:01
可选择排序列。

谢谢！如果班级排名和年级排名都能动态写入单元格就更完美， Set MYCELL = Application.InputBox(prompt:="请选择写入排名数据的列（点击标题栏）", Type:=8)

金樽空对月

grf1973 发表于 2015-11-16 12:01
可选择排序列。

老师，有没有中国式的排名呀，很想学习一下。

安全网

grf1973 发表于 2015-11-16 12:01
可选择排序列。

A列插入序号栏就不能运行时什么原因

grf1973

小改一下。