高級排序在Excel

-1

我在Excel中的數據格式：高級排序在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的百分比最高，總是名稱的百分比是最低的。我希望我能夠解釋它。我真的很感激你的幫助。

來源

2011-09-18 Nupur

好問的超級用戶。 –

你打開vba解決方案嗎？ –

是的！絕對如果你可以告訴我的代碼:) – Nupur

按說明排序。將此公式添加到列D = RANK（VLOOKUP（INDIRECT（「B」& ROW（）），B：C，2，FALSE），C：C）並將列D從最小到最大排序。

來源

2011-09-18 22:18:40 krusaint

這裏有一個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

快速排序從this answer由康拉德·魯道夫

適應

來源

2011-09-18 22:41:31

克里斯，該陣列失敗，除非數據被分組到甚至3個給定此代碼行的描述塊[總是（i \ 3 + 1）= i]。即我試過「總是C 75，有時C 11，通常C 14，總是B 60，有時B 30，通常B 15，總是A 51，總是A 52，總是A 56，有時A 23，通常是25」。您可能需要調整數組大小以避免約束。乾杯。 – brettdj

@brettdj - 是的，正如代碼片段所述，這依賴於數據最初在'Name'和'Description'順序中排序。如果不是這種情況，那麼評論下面的六行就需要替換爲搜索每個「名稱」的「有時」和「通常」項 –

這可能與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

來源

2011-09-19 12:53:16 Fionnuala

高級排序在Excel

回答

相關問題