如何按名次或得分进行升序排列

ykcbf1100

加个辅助列吧。

1. Sub ykcbf()   '//2024.7.29   排序
   
2.     Application.ScreenUpdating = False
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     With Sheets("成绩表")
   
5.         r = .Cells.SpecialCells(xlCellTypeLastCell).Row
   
6.         arr = .[a1].Resize(r, 9)
   
7.         For i = 1 To r
   
8.             If InStr(arr(i, 1), "名次") Then k = k + 1: d(k) = i
   
9.         Next
   
10.         For k = 1 To d.Count
    
11.             r1 = d(k)
    
12.             If k = d.Count Then r2 = r Else r2 = d(k + 1) - 2
    
13.             For i = r1 + 1 To r2
    
14.                 If Val(.Cells(i, 1)) = 0 Then
    
15.                     .Cells(i, 9) = 99
    
16.                 Else
    
17.                     .Cells(i, 9) = Val(.Cells(i, 1))
    
18.                 End If
    
19.             Next
    
20.             Set Rng = .Cells(r1 + 1, 1).Resize(r2 - r1, 9)
    
21.             Rng.Sort .Cells(r1 + 1, 9), 1
    
22.             .Cells(r1 + 1, 9).Resize(r2 - r1) = ""
    
23.         Next
    
24.     End With
    
25.     Set d = Nothing
    
26.     Application.ScreenUpdating = True
    
27.     MsgBox "OK！"
    
28. End Sub
    
29. 
    

复制代码

lybarcom

ykcbf1100 发表于 2024-7-29 19:40
改好了。。。

谢谢老师，太美好了

lybarcom

ykcbf1100 发表于 2024-7-29 19:40
改好了。。。

老师不好意思，又发现一个问题，如果在备注里面添加犯规或者弃权，排序后备注会消失，能否排序后有备注的排在一起

ykcbf1100

lybarcom 发表于 2024-7-29 20:46
老师不好意思，又发现一个问题，如果在备注里面添加犯规或者弃权，排序后备注会消失

你附件就要多写点资料，把可能的情况都考虑进去。你现在这样，没完没了了。

最后一次更新了，后面你自己慢慢研究吧。

lybarcom

ykcbf1100 发表于 2024-7-29 21:00
你附件就要多写点资料，把可能的情况都考虑进去。你现在这样，没完没了了。

最后一次更新了，后面你自 ...

真是太麻烦老师了，考虑不周，是我不好