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（间接（“B”和ROW（）），B：C，2，FALSE），C：C）并将列D排序为最小到最大。

excel中的高级排序

3 个答案: