Excel的排序顺序 - 特殊字符不是第一个

Question

我使用宏在一列进行排序的数据表：

ActiveWorkbook.Worksheets("sheet").Sort.SortFields.Add Key:=Range(sortRange), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal 

有没有一种方法，使在此为了这个代码排序：第一0-9 ，然后是AZ，然后是特殊字符（至少有•和+我喜欢在排序顺序中是最后一个）？

Answer 1

好吧，这听起来像一个有趣的任务，所以我尝试Vityata的方法与另一个工作表中的不同列表。

Sub crazySort() 

Dim ws As Worksheet 
Dim ws2 As Worksheet 
Dim lastRow As Long 
Dim yourcolumnindex, letters, numbers, others As Long 
Dim i As Long 

Set ws = Worksheets("sheet") 
'This is the sheet for our temp lists, rename accordingly 
Set ws2 = Worksheets("tempsheet") 
columnsCount = x 
i = 1 
letters = 1 
others = 1 
numbers = 1 

With ws 
For j = 1 to columnsCount 
    'loop through all the cells in your column 
    'change yourcolumnindex accordingly 
    Do While .Cells(i, j) <> "" 
     'check for the ASCII-code of the first character in every list 

     Select Case Asc(Left(.Cells(i, j), 1)) 
      Case 65 To 90, 97 To 122 
       'if it's a letter, put it in column 1 
       ws2.Cells(letters, 1) = .Cells(i, j) 
       letters = letters + 1 
      Case 48 To 57 
       'if it's a cipher, put it in column 2 
       ws2.Cells(numbers, 2) = .Cells(i, j) 
       numbers = numbers + 1 
      Case Else 
       'is it something else, put it in column 3 
       ws2.Cells(others, 3) = .Cells(i, j) 
       others = others + 1 
     End Select 
     i = i + 1 
    Loop 
Next 
End With 

End Sub 

这部分只包含分割列表，但从这里开始它只是排序和复制/粘贴回来。

玩得开心。

Answer 2

@汤姆，谢谢你提我:) 其实，我想的更多的东西是这样的：

Public Sub SortMe(rng_selection As Range) 

    Dim rng_cell  As Range 
    Dim lst_numbers  As New Collection 
    Dim lst_letters  As New Collection 
    Dim lst_others  As New Collection 
    Dim rng_new   As Range 

    For Each rng_cell In rng_selection 

     Select Case Asc(Left(rng_cell, 1)) 

     Case 65 To 90, 97 To 122 
      lst_letters.Add rng_cell.Text 
     Case 48 To 58 
      lst_numbers.Add rng_cell.Text 
     Case Else 
      lst_others.Add rng_cell.Text 
     End Select 

    Next rng_cell 

    Call SortCollection(lst_numbers) 
    Call SortCollection(lst_letters) 
    Call SortCollection(lst_others) 

    For Each rng_cell In rng_selection 

     If lst_numbers.Count Then 
      rng_cell = lst_numbers.Item(1) 
      lst_numbers.Remove (1) 

     ElseIf lst_letters.Count Then 
      rng_cell = lst_letters.Item(1) 
      lst_letters.Remove (1) 

     ElseIf lst_others.Count Then 
      rng_cell = lst_others(1) 
      lst_others.Remove (1) 

     End If 
    Next rng_cell 

    Set rng_new = rng_selection.Offset(0, 1) 

End Sub 

Sub SortCollection(ByRef oCollection As Collection, Optional bSortAscending As Boolean = True) 
    'taken from http://visualbasic.happycodings.com/applications-vba/code27.html 
    Dim lSort1 As Long, lSort2 As Long 
    Dim vTempItem1 As Variant, vTempItem2 As Variant, bSwap As Boolean 

    On Error GoTo ErrFailed 
    For lSort1 = 1 To oCollection.Count - 1 
     For lSort2 = lSort1 + 1 To oCollection.Count 
      If bSortAscending Then 
       If oCollection(lSort1) > oCollection(lSort2) Then 
        bSwap = True 
       Else 
        bSwap = False 
       End If 
      Else 
       If oCollection(lSort1) < oCollection(lSort2) Then 
        bSwap = True 
       Else 
        bSwap = False 
       End If 
      End If 
      If bSwap Then 
       'Store the items 
       If VarType(oCollection(lSort1)) = vbObject Then 
        Set vTempItem1 = oCollection(lSort1) 
       Else 
        vTempItem1 = oCollection(lSort1) 
       End If 

       If VarType(oCollection(lSort2)) = vbObject Then 
        Set vTempItem2 = oCollection(lSort2) 
       Else 
        vTempItem2 = oCollection(lSort2) 
       End If 

       'Swap the items over 
       oCollection.Add vTempItem1, , lSort2 
       oCollection.Add vTempItem2, , lSort1 
       'Delete the original items 
       oCollection.Remove lSort1 + 1 
       oCollection.Remove lSort2 + 1 
      End If 
     Next 
    Next 
    Exit Sub 

ErrFailed: 
    Debug.Print "Error with CollectionSort: " & Err.Description 
    CollectionSort = Err.Number 
    On Error GoTo 0 

End Sub 

它只是看起来大，排序子是相当大的，但我复制并粘贴它。它为我工作。如果您想调用它，请在即时窗口call SortMe(selection)中写下，并且不要忘记选择范围。 :)祝你有个愉快的夜晚：D