高级排序在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

回答

相关问题