Question

我使用宏来按一列中的数据对表进行排序：

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

有没有办法让这个代码按此顺序排序：首先是0-9，然后是A-Z，然后是特殊字符（至少有•和+我喜欢在排序顺序中排在最后）？

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

@Tom，谢谢你提到我:) 实际上，我在考虑更像这样的事情：

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

Excel排序顺序 - 不是特殊字符

2 个答案: