vba 排序循环需要排名

vba sort loop requires rank

我有一个 spreadsheet,每个 week.It 有 5 个字段,name(A 列),year(B 列),level(C 列),week( columnD) 和 score(ColE)。每个学生在 sheet 上都有自己的块,每个行块由空 row.The 块分隔,行块的大小会有所不同。(请参见下文)。
我有代码将分数(E 列)从最高到最低排序,(请参阅排序前和排序后)
我想做的是在周列和分数列之间插入另一列,给出排序后每个分数的位置,它会出现在下面的图 3 中。我认为这需要某种RANK 程序和 loop.Notice 有时学生在某些周内的分数可能相同,因此会有一个联合最高(或第二或第三等),就像 John Ellis 联合第四名一样,有两组54 和 phil simm 并列第 1 和第 4。
希望这能让 sense.Any 大加赞赏
在 spreadshhet 数字的底部,我还放置了我用于循环和排序 E 列(分数列)的代码。

BEFORE SORT(Fig1)                   
name       year     level   week    score   
jill evans  5         2      10       56    
jill evans  5         2      11       49    
jill evans  5         2      12       77    
jill evans  5         2      13      84 
empty   empty   empty   empty   empty   
john ellis  3   4   10  45  
john ellis  3   4   11  54  
john ellis  3   4   12  54  
john ellis  3   4   13  29  
john ellis  3   4   14  66  
empty   empty   empty   empty   empty   
phil simm   4   6   10  89  
phil simm   4   6   11  76  
phil simm   4   6   12  41  
phil simm   4   6   13  41  
phil simm   4   6   14  56  
phil simm   4   6   15  59  
phil simm   4   6   16  61  
phil simm   4   6   17  61  




AFTER SORT(Fig2)                    

name        year    level   week        score
jill evans  5        2       11         49
jill evans  5        2       10         56
jill evans  5        2       12         77
jill evans  5        2       13         84
empty   empty   empty   empty       empty
john ellis  3   4   13      29
john ellis  3   4   10      45
john ellis  3   4   11      54
john ellis  3   4   12      54
john ellis  3   4   14      66
empty   empty   empty   empty       empty
phil simm   4   6   12      41
phil simm   4   6   13      41
phil simm   4   6   14      56
phil simm   4   6   15      59
phil simm   4   6   16      61
phil simm   4   6   17      61
phil simm   4   6   11      76
phil simm   4   6   10      89

    FIG3 with the position row included between week col and score       col                    
name          year  level   week    position    score
jill evans       5   2       11         1       49
jill evans       5   2       10         2       56
jill evans       5   2       12         3       77
jill evans       5   2       13         4       84
empty   empty   empty   empty   empty   empty
john ellis  3   4   13  1   29
john ellis  3   4   10  2   45
john ellis  3   4   11  3   54
john ellis  3   4   12  3   54
john ellis  3   4   14  4   66
empty   empty   empty   empty   empty   empty
phil simm   4   6   12  1   41
phil simm   4   6   13  1   41
phil simm   4   6   14  2   56
phil simm   4   6   15  3   59
phil simm   4   6   16  4   61
phil simm   4   6   17  4   61
phil simm   4   6   11  5   76
phil simm   4   6   10  6   89

因此位置列反映了排序后得分的新位置。
如果两个分数相同,那么这将是一个联合位置,例如约翰·埃利斯(John Ellis)以两组 54 并列第 4,菲尔·西姆(phil simm)并列第 1 和第 4。
希望这个 nakes sense.Any 帮助非常感谢

Sub sortone()                   

Application.ScreenUpdating = False                  
Dim Area As Range, sr As Long, er As Long                   
For Each Area In Range("A2", Range("E" &   Rows.Count).End(xlUp)).SpecialCells(xlCellTypeConstants).Areas                   
  With Area                 
    sr = .Row                   
    er = sr + .Rows.Count - 1                   
    Range("A" & sr & ":E" & er).Sort key1:=Range("E" & sr),   order1:=1                 
  End With                  
Next Area                   
Application.ScreenUpdating = True                   
End Sub                 

非常感谢

"RankIf" 使用 SUMPRODUCT:

按子集进行条件排名

另一种排名方式,有点像 RANKIF 函数,使用 SUMPRODUCT 进行条件排名:

D5中的公式:

=1+SUMPRODUCT((A:A=A5)*($B:$B>B5))            

...absolute/relative 单元格引用设置为允许复制或向下和向右填充公式。


更多信息:

你可以试试这个代码

Option Explicit

Sub sortone()
    Dim Area As Range

    Application.ScreenUpdating = False

    With Range("A1", Range("A" & Rows.Count).End(xlUp))
        .Columns(5).Insert
        .Cells(1, 5).Value = "position"

        For Each Area In .Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeConstants).Areas
            With Area
                .Resize(, 6).Sort key1:=.Range("F1"), order1:=1
                .Offset(, 4).FormulaR1C1 = "=RANK(RC[1]," & .Offset(, 5).Resize(, 1).Address(, , xlR1C1) & ",1)"
            End With
        Next Area
    End With

    Application.ScreenUpdating = True
End Sub
name        year    level   week    position    score
john ellis   3        4     13       1           29
phil simm    4        6     12       2           41
phil simm    4        6     13       2           41
john ellis   3        4     10       4           45
jill evans   5        2     11       5          49
john ellis   3        4     11       6           54
john ellis   3        4     12       6           54
jill evans   5        2     10       8           56
phil simm    4        6     14       8           56
phil simm    4        6     15      10           59
phil simm    4        6     16      11          61
phil simm    4        6     17      11           61
john ellis   3        4     14      13           66
phil simm    4        6     11      14           76
jill evans   5        2     12      15           77
jill evans   5        2     13      16           84
phil simm    4        6     10      17           89
empty   empty   empty   empty   #VALUE! empty
empty   empty   empty   empty   #VALUE! empty