VBA按总评分排名

liaotian1

A列是一到六年级
K列是计算出来的“总评分”
L列根据K列的“总评分”进行降序排名（请不要告诉我运用L6=RANK.EQ(K6,K$6:K$92)排名）

1. 
   
2. Sub 一至六年级排名()
   
3. For i = 6 To 20
   
4. aaa = ""
   
5. 
   
6. aaa = Application.WorksheetFunction.Rank(Cells(i, 11).Value, Range("k6:k92"), 0)
   
7. 
   
8. 
   
9. 
   
10. 
    
11. Cells(i, 12).Value = aaa
    
12. 
    
13. Next i
    
14. End Sub
    
15. 
    

复制代码

请问：在里面要加上什么内容，才会分年级进行降序排名？谢谢






求助：按总评分降序排名.rar (23.61 KB, 下载次数: 46)

2016-7-22 09:25 上传

点击文件名下载附件

zhjlgaojuan

Sub ò»ÖááùÄ꼶ÅÅÃû()
Dim SourceArr, Temp1, Temp2, TargetArr
SourceArr = Range("K6:K92")
TargetArr = Range("L6:L92")
For I = 1 To UBound(TargetArr)
  TargetArr(I, 1) = 1
Next
Temp1 = 1
For I = 1 To UBound(SourceArr)
   If SourceArr(I, 1) = "" Or I = UBound(SourceArr) Then
      If SourceArr(I, 1) = "" Then TargetArr(I, 1) = ""
      If I < UBound(SourceArr) Then Temp2 = I - 1 Else Temp2 = I
      For j = Temp1 To Temp2
         For k = Temp1 To Temp2
            If SourceArr(j, 1) < SourceArr(k, 1) Then TargetArr(j, 1) = TargetArr(j, 1) + 1
         Next
      Next
      Temp1 = I + 1
   End If
Next
[L6].Resize(UBound(TargetArr), UBound(TargetArr, 2)) = TargetArr
End Sub

你附件中六年级的数据格式记得修改下

zhjlgaojuan

额,过程名怎么成乱码了?

liaotian1

zhjlgaojuan 发表于 2016-7-22 10:10
Sub ò&raquo;&Ouml;ááù&Auml;ê&frac14;&para;&Aring;&Aring;&Atilde;&ucirc;()
Dim SourceArr, Temp1, Temp2, ...

谢谢老师
如果我再增加一行“总评分”（如图U列），又该怎么修改你的代码呢？请赐教




附件增加了新的“总评分”
求助：按总评分降序排名.rar (26.02 KB, 下载次数: 28)

2016-7-22 10:28 上传

点击文件名下载附件

zhjlgaojuan

Sub 排名()
Dim SourceArr, Temp1, Temp2, TargetArr1, TargetArr2
SourceArr = Range("A6:V92")
TargetArr1 = Range("L6:L92")
TargetArr2 = Range("V6:V92")
For i = 1 To UBound(TargetArr1)
  TargetArr1(i, 1) = 1
  TargetArr2(i, 1) = 1
Next
Temp1 = 1
For i = 1 To UBound(SourceArr)
   If SourceArr(i, 1) = "" Or i = UBound(SourceArr) Then
      If SourceArr(i, 1) = "" Then
         TargetArr1(i, 1) = ""
         TargetArr2(i, 1) = ""
      End If
      If i < UBound(SourceArr) Then Temp2 = i - 1 Else Temp2 = i
      For j = Temp1 To Temp2
         For k = Temp1 To Temp2
            If CLng(SourceArr(j, 11)) < CLng(SourceArr(k, 11)) Then TargetArr1(j, 1) = TargetArr1(j, 1) + 1
            If CLng(SourceArr(j, 21)) < CLng(SourceArr(k, 21)) Then TargetArr2(j, 1) = TargetArr2(j, 1) + 1
         Next
      Next
      Temp1 = i + 1
   End If
Next
[L6].Resize(UBound(TargetArr1), 1) = TargetArr1
[V6].Resize(UBound(TargetArr2), 1) = TargetArr2
End Sub

lsc900707

亲，楼主马上还会增加一个AE列的，干脆提前给他写了。

liaotian1

zhjlgaojuan 发表于 2016-7-22 10:42
Sub 排名()
Dim SourceArr, Temp1, Temp2, TargetArr1, TargetArr2
SourceArr = Range("A6:V92")

非常感谢，还有一点问题，图中红色部分




这是附件里面运算的结果，麻烦修改一下，谢谢
看看排名中的红色部分.rar (27.68 KB, 下载次数: 69)

2016-7-22 12:09 上传

点击文件名下载附件

zhjlgaojuan

我的失误....因为你K列数据中有文本格式的评分,结果我转换成数值时我误用了CLNG(),你把里面的这个函数改成CDBL()就好了

liaotian1

zhjlgaojuan 发表于 2016-7-22 14:25
我的失误....因为你K列数据中有文本格式的评分,结果我转换成数值时我误用了CLNG(),你把里面的这个函数改成C ...

谢谢回复

hq200078

收藏一下,终于找到了