2016-07-28 55 views
2

我使用宏在一列進行排序的數據表:Excel的排序順序 - 特殊字符不是第一個

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

有沒有一種方法,使在此爲了這個代碼排序:第一0-9 ,然後是AZ,然後是特殊字符(至少有•和+我喜歡在排序順序中是最後一個)?

+2

逐個讀取範圍。根據它們的內容將單元格放入不同的列表(或數組)中。你會有3個列表(或數組)。然後對列表(或數組)進行排序。然後逐一打印。瞧! :) – Vityata

+0

謝謝!是的,現在我必須找到排序表的代碼,而不僅僅是列內容 – cody

回答

2

好吧,這聽起來像一個有趣的任務,所以我嘗試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 

這部分只包含分割列表,但從這裏開始它只是排序和複製/粘貼回來。

玩得開心。

+0

謝謝!你是否也有想整理整個桌子的想法?這似乎只是複製列內容... – cody

+0

我改變了代碼,所以現在它將適用於所有列。只需將'columnsCount = x'更改爲最後一列的索引即可。如果您的第一列不是「A」,則相應地更改'j = 1'。請記住,這會將源表的_all_列的值放入「tempsheet」的三列中。 –

1

@湯姆,謝謝你提我:) 其實,我想的更多的東西是這樣的:

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

+0

啊好吧...我會試試看,謝謝:) – cody

+0

但你能告訴我,我怎麼可以將它應用到整個表的行?該列是表格的一部分... – cody

+0

對於整行來說,這會有點棘手。您必須讀取所有列並將它們相應地添加到lst_letters,lst_numbers或lst_others。您可以通過「::」或類似的方式將它們分開,然後每行打印每個單元格,並用「::」符號將它們分開。因此,在列表中,你會爲每一行提供像這樣的「First_cell :: second_cell,:: third_cell_etc」。或類似的東西。 – Vityata