首页 > 解决方案 > 按 Excel 字母数字排序

问题描述

我有一张需要按字母数字列排序的 Excel 表。我目前可以这样做,但这是一个丑陋的方法,我想有一个 vba 宏来代替。它是数字 3-22 和字母 AZ,目前我只能让 vba 对其进行排序 3-22 并且它忽略了字母部分。我需要 3(AZ) 然后 4(AZ) 等,它需要对整张纸进行排序。

目前我可以按如下方式完成:创建两个新列,第一个

=IF(LEN(A4)=2,"0"&LEFT(A4,1),LEFT(A4,2))

“0”是允许 excel 将新拆分数字视为数字并允许我处理一位数和两位数所必需的。

第二栏:

=RIGHT(A3,1) 

这很有效,因为我总是将字母作为第二个数字。然后我必须按 B 列排序,然后按 C 排序。所以我使用 GUI 来“按时排序”。

我想要一个可以自动执行我上面提到的 GUI 点击和公式输入的宏

我录制了一个宏来做到这一点,这就是我得到的:

Columns("C:C").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("C3").Select
ActiveCell.FormulaR1C1 = _
    "=IF(LEN(RC[-1])=2,""0""&LEFT(RC[-1],1),LEFT(RC[-1],2))"
Range("B3").Select
Selection.End(xlDown).Select
Range("C162").Select
Range(Selection, Selection.End(xlUp)).Select
Selection.FillDown
Range("D3").Select
ActiveCell.FormulaR1C1 = "=RIGHT(RC[-2],1)"
Range("C3").Select
Selection.End(xlDown).Select
Range("D162").Select
Range(Selection, Selection.End(xlUp)).Select
Selection.FillDown
Range("A1:E162").Select
Range("D162").Activate
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add2 Key:=Range("C1:C162" _
    ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortTextAsNumbers
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add2 Key:=Range("D1:D162" _
    ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
    .SetRange Range("A1:E162")
    .Header = xlGuess
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

我真的希望这更干净,所以我可以按字母数字列对数据表进行排序,这样我得到 1(AZ)然后是 2(AZ)。理想输出:1A 2B 3C 2A 2B 2C 等

标签: excelvbasortingalphanumeric

解决方案


要使用此示例,您必须从 Chip Pearson 的网站获取三个例程。在您的 VBA 编辑器中创建一个新的空模块并粘贴到例程SortDictionary(位于页面底部)、QSortInPlace 和 QSortCompare中。每当我进行任何类型的排序时,这是我的首选库,我知道它会起作用。

要对数据进行排序,您必须将数字和字母分开并分别排序。此示例假定单元格中有一个数字(多个字符)和一个字母(单个字符)。我的测试数据是

7C
18F
22K
7Q
12G
17Q
21I
15F
13D
20U
11A
11W
14M
10Q
4B
20W
12K
19R
12Y
13Q
3Y
18J
9J
6P
11U

因为可能(并且在测试数据中)一个数字多次出现(可能)不同的字母,所以您必须创建某种所有数字的集合并将所有可能存在的字母关联起来。查看11列表中的数字,条目包括11A11W11U。在我的示例中,我正在创建一个添加Dictionary条目的11位置,并且字母列表与之相关联A,W,U

构建结果数组然后只使用排序后的数字,并为每个数字拉出(潜在的)字母列表,并对字母进行排序并将其添加到结果中。

Option Explicit

Sub test()
    SortSpecial Range("A1:A25")
End Sub

Sub SortSpecial(ByRef thisArea As Range)
    Dim numberPart As String
    Dim letterPart As String

    '--- build a Dictionary for the initial organization
    Dim list As Dictionary
    Set list = New Dictionary

    Dim cell As Range
    For Each cell In thisArea
        '--- the letter is always the last single character
        letterPart = Right$(cell.Value, 1)
        numberPart = Left$(cell.Value, Len(cell.Value) - 1)
        If list.Exists(numberPart) Then
            '--- add the letter to the list
            list(numberPart) = list(numberPart) & "," & letterPart
        Else
            list.Add numberPart, letterPart
        End If
    Next cell

    SortDictionary list, SortByKey:=True

    '--- now create an array for the results
    Dim i As Long
    Dim j As Long
    Dim number As Variant
    Dim lastNumber As Long
    Dim results As Variant
    ReDim results(1 To thisArea.Rows.Count, 1 To 1)
    i = 1
    For Each number In list
        Dim letters() As String
        letters = Split(list(number), ",")
        If UBound(letters) > LBound(letters) Then
            If Not QSortInPlace(letters) Then
                MsgBox "error sorting the letters!"
                Exit Sub
            End If
        End If
        For j = LBound(letters) To UBound(letters)
            results(i, 1) = number & letters(j)
            i = i + 1
        Next j
    Next number

    '--- put the results back on the sheet
    thisArea = results
End Sub

推荐阅读