重复的排名会跳过下一个数，怎么改？

fengziiiiii

重复的排名会跳过下一个数，怎么改？如图


这是我的代码

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.     Dim ws As Worksheet
   
3.     Dim lastRow As Long
   
4.     Dim i As Long
   
5.    
   
6.     ' 指定工作表
   
7.     Set ws = ThisWorkbook.Sheets("成绩总览")
   
8.    
   
9.     ' 获取最后一行
   
10.     lastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
    
11.    
    
12.     ' 检查是否发生在"C8:K"最后一行之间的更改
    
13.     If Not Intersect(Target, ws.Range("C8:K" & lastRow)) Is Nothing Then
    
14.         ' 循环每一行
    
15.         For i = 8 To lastRow
    
16.             ' 计算总分
    
17.             ws.Cells(i, "L").Value = Application.WorksheetFunction.Sum(ws.Range("C" & i & ":K" & i))
    
18.             
    
19.             ' 计算排名
    
20.             ws.Cells(i, "M").Formula = "=SUMPRODUCT((A$8:A$" & lastRow & "=A" & i & ")*(L$8:L$" & lastRow & ">L" & i & "))+1"
    
21.             
    
22.             ' 将排名公式结果复制为数值
    
23.             ws.Cells(i, "M").Value = ws.Cells(i, "M").Value
    
24.         Next i
    
25.     End If
    
26. End Sub

复制代码

排名 .zip (22.18 KB, 下载次数: 7)

2024-1-18 01:06 上传

点击文件名下载附件

yjh_27

你这是在代码中用公式，函数公式 板块 搜 中式排名

无关岁月

副本排名.7z (26 KB, 下载次数: 5)

2024-1-18 10:25 上传

点击文件名下载附件

1. =SUMPRODUCT((A$8:A$97=A8)*(L$8:L$97>=L8)/COUNTIFS(A$8:A$97,A$8:A$97,L$8:L$97,L$8:L$97))

复制代码

fengziiiiii

yjh_27 发表于 2024-1-18 09:44
你这是在代码中用公式，函数公式 板块 搜 中式排名

好的，我看看

fengziiiiii

无关岁月 发表于 2024-1-18 10:25

谢谢你，太厉害了了，以一种我看不懂的方式实现了

无关岁月

fengziiiiii 发表于 2024-1-18 11:04
谢谢你，太厉害了了，以一种我看不懂的方式实现了

公式你应该能看懂，用公式也行，就是数据多的时候，效率差点