如何根据原始表中关键列学科和分数分别从高到低排序

yzyyyyyyy

原始表：关键列分数，学科（有多个学科）

目标表：根据学科列，不同的关键字，将分数列分段从高到低排序 如何根据原始表中关键列学科和分数分别从高到低排序.rar (6.53 KB, 下载次数: 13)

2024-11-5 15:54 上传

点击文件名下载附件

kevinchengcw

[a1].currentregion.offset(1).sort [i2],,[d2],,2

ykcbf1100

双条件排序

ykcbf1100

参与一下。。。

gwjkkkkk

Option Explicit
Sub TEST2()
    Dim ar, i&, p&
   
    Application.ScreenUpdating = False
   
    With Worksheets(1).[A1].CurrentRegion
        ar = .Resize(.Rows.Count + 1).Value
        bSort ar, 2, UBound(ar), 1, UBound(ar, 2), UBound(ar, 2), False
        p = 2
        For i = 2 To UBound(ar) - 1
            If ar(i + 1, UBound(ar, 2)) <> ar(p, UBound(ar, 2)) Then
                bSort ar, p, i, 1, UBound(ar, 2), 4, False
                p = i + 1
            End If
        Next i
    End With
   
    With Worksheets(2)
        .Cells.Clear
        .[A1].Resize(UBound(ar), UBound(ar, 2)) = ar
        .Activate
    End With
   
    Application.ScreenUpdating = True
    Beep
End Sub
Function bSort(ByRef ar, ByVal iFirst&, ByVal iLast&, ByVal iLeft&, _
    ByVal iRight&, ByVal iKey&, Optional isOrder As Boolean = True)
    Dim i&, j&, k&, vTemp
   
    For i = iFirst To iLast - 1
        For j = iFirst To iLast + iFirst - 1 - i
            If ar(j, iKey) <> ar(j + 1, iKey) Then
                If ar(j, iKey) < ar(j + 1, iKey) Xor isOrder Then
                    For k = iLeft To iRight
                        vTemp = ar(j, k)
                        ar(j, k) = ar(j + 1, k)
                        ar(j + 1, k) = vTemp
                    Next
                End If
            End If
        Next j
    Next i
End Function

gwjkkkkk

参与一下。。。

cunfu2010

kevinchengcw 发表于 2024-11-5 16:14
[a1].currentregion.offset(1).sort ,,[d2],,2

yzyyyyyyy

gwjkkkkk 发表于 2024-11-5 19:13
参与一下。。。

如何根据原始表中关键列学科和分数分别从高到低排序.rar (10.48 KB, 下载次数: 5)

2024-11-20 16:01 上传

点击文件名下载附件

感谢大师热心帮助，现在已按从高到低顺序了，学科的先后顺序变了。能否学科仍按原始表中出现的顺序，即同一学科在一块

gwjkkkkk

yzyyyyyyy 发表于 2024-11-20 16:01
感谢大师热心帮助，现在已按从高到低顺序了，学科的先后顺序变了。能否学科仍按原始表中出现的顺序，即同 ...

请参考。。。

gwjkkkkk

改一句即可。。。。