Excelsorting顺序 – 不是特殊字符

我使用一个macros按照一列中的数据对表格进行sorting：

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

有没有办法使这个代码按照这个顺序sorting：先是0-9，然后是AZ，然后是特殊字符（至less有和我最喜欢的sorting顺序+）？

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 

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

玩得开心。

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 

它看起来很大，sorting分很大，但我复制并粘贴它。 它为我工作。 如果你想调用它，在立即窗口中写入call SortMe(selection) ，不要忘记select范围。 :)有一个愉快的夜晚：D