excel中的高级排序

Question

我有一个excel格式的数据：

Description      Name            Percent
Always             A               52
Sometimes          A               23
Usually            A               25      
Always             B               60
Sometimes          B               30
Usually            B               15 
Always             C               75
Sometimes          C               11
Usually            C               14

我想对这些数据进行排序：

对于每个名称，描述顺序必须相同（例如：总是后跟有时后跟通常），但是对于三个名称 A、B 和 C，我想将始终百分比从小到大排序。例如：我希望上面的例子在排序后看起来像这样：

Description      Name            Percent
Always             C               75
Sometimes          C               11
Usually            C               14      
Always             B               60
Sometimes          B               30
Usually            B               15 
Always             A               52
Sometimes          A               23
Usually            A               25

名字 C 的百分比总是最高的，名字 A 的百分比总是最低的。我希望我能够解释它。非常感谢您对此提供的帮助。

Answer 1

这是一个执行这种排序的 vba 例程：

选择工作表上的数据并运行SortList

重要提示：此代码假定 Always、Sometimes、Usually 数据按 Name 分组（如在您的示例数据中）

方法：

Sub SortList()
    Dim dat As Variant
    Dim rng As Range
    Dim newDat() As Variant
    Dim always() As Long
    Dim i As Long

    Set rng = Selection

    If rng.Columns.Count <> 3 Then
        MsgBox "Select a range with 3 columns", vbCritical + vbOKOnly
        Exit Sub
    End If

    If StrComp(rng.Cells(1, 1), "Description", vbTextCompare) = 0 Then
        Set rng = rng.Offset(1, 0).Resize(rng.Rows.Count - 1, 3)
    End If

    dat = rng
    ReDim always(1 To UBound(dat, 1) / 3)

    For i = 1 To UBound(dat)
        If StrComp(dat(i, 1), "Always", vbTextCompare) = 0 Then
            always(i \ 3 + 1) = i
        End If
    Next

    QuickSort dat, always, LBound(always, 1), UBound(always, 1)


    ReDim newDat(1 To UBound(dat, 1), 1 To 3)
    For i = 1 To UBound(always)
        newDat((i - 1) * 3 + 1, 1) = dat(always(i), 1)
        newDat((i - 1) * 3 + 1, 2) = dat(always(i), 2)
        newDat((i - 1) * 3 + 1, 3) = dat(always(i), 3)

        ' Assumes original data is sorted in name order
        newDat((i - 1) * 3 + 2, 1) = dat(always(i) + 1, 1)
        newDat((i - 1) * 3 + 2, 2) = dat(always(i) + 1, 2)
        newDat((i - 1) * 3 + 2, 3) = dat(always(i) + 1, 3)
        newDat((i - 1) * 3 + 3, 1) = dat(always(i) + 2, 1)
        newDat((i - 1) * 3 + 3, 2) = dat(always(i) + 2, 2)
        newDat((i - 1) * 3 + 3, 3) = dat(always(i) + 2, 3)

    Next

    rng = newDat

End Sub


Private Sub QuickSort(ByRef dat As Variant, ByRef Field() As Long, ByVal LB As Long, ByVal UB As Long)
    Dim P1 As Long, P2 As Long, Ref As Variant, TEMP As Long

    P1 = LB
    P2 = UB
    Ref = dat(Field((P1 + P2) / 2), 3)

    Do
        Do While dat(Field(P1), 3) > Ref
            P1 = P1 + 1
        Loop

        Do While dat(Field(P2), 3) < Ref
            P2 = P2 - 1
        Loop

        If P1 <= P2 Then
            TEMP = Field(P1)
            Field(P1) = Field(P2)
            Field(P2) = TEMP

            P1 = P1 + 1
            P2 = P2 - 1
        End If
    Loop Until (P1 > P2)

    If LB < P2 Then Call QuickSort(dat, Field, LB, P2)
    If P1 < UB Then Call QuickSort(dat, Field, P1, UB)
End Sub

Quicksort 改编自 Konrad Rudolph 的 this answer

Answer 2

使用 ADO 可能会更容易：

Dim cn As Object
Dim rs As Object
Dim strFile As String
Dim strCon As String
Dim strSQL As String
Dim i As Integer

strFile = "C:\Docs\Book2.xlsm"

''Note that if HDR=No, F1,F2 etc are used for column names,
''if HDR=Yes, the names in the first row of the range
''can be used.
''Comment out the connection string, as appropriate.
''This is the Jet 4 connection string, for < 2007:

strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFile _
    & ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"

''ACE, for 2007 -
strCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFile _
    & ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"

''Late binding, so no reference is needed

Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")


cn.Open strCon

strSQL = "SELECT s1.[Description], s1.[Name], s1.[Percent] " _
       & "FROM [Sheet3$] s1 " _
       & "INNER JOIN (SELECT s.Name, s.Percent " _
       & "FROM [Sheet3$] s " _
       & "WHERE s.Description='Always') As s2 " _
       & "ON s1.Name = s2.Name " _
       & "ORDER BY s2.Percent DESC, s1.Description"

rs.Open strSQL, cn, 3, 3


''Pick a suitable empty worksheet or location for the results
With Worksheets("Sheet4")
    For i = 1 To rs.Fields.Count
        .Cells(1, i) = rs.Fields(i - 1).Name
    Next

    .Cells(2, 1).CopyFromRecordset rs
End With

''Tidy up
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing

Answer 3

按描述排序。将此公式添加到 D 列 =RANK(VLOOKUP(INDIRECT("B"&ROW()),B:C, 2, FALSE),C:C ) 并按从小到大对 D 列进行排序。