同一表中男女生的成绩反向排序处理

wengjl

附件就用这个
https://club.excelhome.net/forum ... 4NjAwfDE3MDA0NTE%3D


我要求助的是，如何用VBA实现：先分别按男女生排序，再按成绩总分排序，成绩的排序规则是 男的降序，则女的升序，如果男的成绩升序，则女的成绩就降序，这个排序如何实现？

demonimissyou

用sql很快搞定

chxw68

1. Sub test()
   
2.     Dim r%, i%
   
3.     Dim arr, brr
   
4.     Dim rng As Range
   
5.     With Worksheets("报名信息")
   
6.         .AutoFilterMode = False
   
7.         r = .Cells(.Rows.Count, 1).End(xlUp).Row
   
8.         .Range("a4:t" & r).Sort key1:=.Range("c4"), order1:=xlAscending, Header:=xlNo
   
9.         Set rng = .Columns(3).Find(what:="女", LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByColumns, searchdirection:=xlNext)
   
10.         If rng Is Nothing Then
    
11.             .Range("a4:t" & r).Sort key1:=.Range("p4"), order1:=xlDescending, Header:=xlNo
    
12.         Else
    
13.             r0 = rng.Row
    
14.             .Range("a4:t" & r0 - 1).Sort key1:=.Range("p4"), order1:=xlDescending, Header:=xlNo
    
15.             .Range(.Cells(r0, 1), .Cells(r, 20)).Sort key1:=.Cells(r0, 16), order1:=xlAscending, Header:=xlNo
    
16.         End If
    
17.     End With
    
18. End Sub
    

复制代码

chxw68

详见附件。

chxw68

用辅助列排序。

1. Sub test3()
   
2.     Dim r%, i%
   
3.     Dim arr, brr
   
4.     Dim rng As Range
   
5.     With Worksheets("报名信息")
   
6.         .AutoFilterMode = False
   
7.         r = .Cells(.Rows.Count, 1).End(xlUp).Row
   
8.         arr = .Range("a4:t" & r)
   
9.         ReDim brr(1 To UBound(arr), 1 To 1)
   
10.         For i = 1 To UBound(arr)
    
11.             If arr(i, 3) = "男" Then
    
12.                 brr(i, 1) = 10 ^ 4 + arr(i, 16)
    
13.             Else
    
14.                 brr(i, 1) = -arr(i, 16)
    
15.             End If
    
16.         Next
    
17.         .Range("u4").Resize(UBound(brr), UBound(brr, 2)) = brr
    
18.         .Range("a4:u" & r).Sort key1:=.Range("u4"), order1:=xlDescending, Header:=xlNo
    
19.         .Columns(21).Clear
    
20.     End With
    
21. End Sub
    
22. 
    

复制代码

chxw68

感觉用辅助列排序还是方便一些。

wengjl

非常感谢chxw68的大力相助！

MHanys

~~~~~~~~~~~~~~~~~~~~~~~~~~~