使用 VBA 宏按最后两位数字对数字进行排序答案

【问题标题】：Sorting Numbers By Last Two Digits Using VBA Macro使用 VBA 宏按最后两位数字对数字进行排序
【发布时间】：2017-07-26 20:56:12
【问题描述】：

我有一个包含大量 5 位数字列表的电子表格。我想按最后 2 位数字来组织这些数字。我有一个有效的公式可以做到这一点，所以这不是我的问题。我现在的问题是这些数字是按最后 2 位数字组织的，现在有什么方法可以按所有 5 位数字对这些数字进行排序吗？我的意思是：我的号码现在是这样排列的：

我现在要做的是再次按所有 5 位数字对它们进行排序，但也在按最后 2 位数字对它们进行排序的子集中，如下所示：

这可能吗？

下面是按最后两位数字对数字进行排序的代码：

[B:B].Insert Shift:=xlToRight
n = [A65000].End(xlUp).Row
For Each c In Range("A1:A" & n)
c.Offset(0, 1) = Right(c, 2)
Next c
Range("A1:B" & n).Sort Key1:=[B2], Order1:=xlAscending
[B:B].Delete

【问题讨论】：

创建一个 3 位列和一个 2 位列。高级排序界面允许您先按一列排序，然后再按另一列排序。
谢谢，我会这样做的。
抱歉，John Coleman，我不小心删除了您的评论。我已经编辑了我的问题以包含代码。
您创建新列、按其排序然后删除的方法似乎合乎逻辑。您可以做的是创建两个新列，一个与您已有的相同，另一个使用 Left 而不是 Right。在排序命令中使用Key2 和Option2。删除最后的两列。顺便说一句——当它变得没有意义时，我删除了我的评论。您不能删除其他人的评论（除非您具有版主身份）。
我是在删除第一列之前还是之后添加这个新列？

标签： vba excel sorting numbers

【解决方案1】：

您在最后一条评论中的解决方案似乎很简单；这做同样的事情（Sheet1，Col A）

Public Sub CustomSort()
    Const START_ROW = 2, START_COL = 1
    Dim ws As Worksheet, lr As Long, lFormula As String, rFormula As String
    Dim sortL As Range, sortR As Range

    Application.ScreenUpdating = False
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    lr = ws.Cells(Rows.Count, "A").End(xlUp).Row

    ws.Columns(START_COL + 1).Insert Shift:=xlToRight
    ws.Columns(START_COL + 2).Insert Shift:=xlToRight
    lFormula = "=LEFT(" & Replace(ws.Cells(START_ROW, START_COL).Address, "$", "") & ",3)"
    rFormula = "=RIGHT(" & Replace(ws.Cells(START_ROW, START_COL).Address, "$", "") & ",2)"

    With ws.UsedRange   'Apply Formulas
        .Columns(START_COL + 1).Offset(1).Formula = lFormula
        .Columns(START_COL + 2).Offset(1).Formula = rFormula
        Set sortL = .Columns(START_COL + 1).Offset(1).Resize(lr - 1)
        Set sortR = .Columns(START_COL + 2).Offset(2).Resize(lr - 1)
    End With

    With ws.Sort        'Apply Sort
        With .SortFields
            .Clear
            .Add Key:=sortR
            .Add Key:=sortL
        End With
        .SetRange ws.UsedRange.Offset(1).Resize(lr - 1)
        .Apply
    End With

    ws.Columns(START_COL + 2).Delete    'Remove helper columns (if needed)
    ws.Columns(START_COL + 1).Delete    'Remove helper columns (if needed)
    Application.ScreenUpdating = True
End Sub

结果：

Before | After
--------------
12300  | 12300
15600  | 12400
12400  | 15600
15700  | 15700
12301  | 12301
15601  | 12401
12401  | 15601
15601  | 15601

【讨论】：

【解决方案2】：

试试这个代码。

Sub test()
    Dim vDB, vNew()
    Dim Ws As Worksheet
    Dim n As Long, i As Long
    Set Ws = ActiveSheet

    With Ws
        vDB = .Range("a1", .Range("a" & Rows.Count).End(xlUp))
        n = UBound(vDB, 1)
        ReDim vNew(1 To n, 1 To 2)
        For i = 1 To n
            vNew(i, 1) = Left(vDB(i, 1), 3)
            vNew(i, 2) = Right(vDB(i, 1), 2)
        Next i
        .Range("b:c").Insert
        .Range("b1").Resize(n, 2) = vNew
        .Range("a1").CurrentRegion.Sort Key1:=Range("c1"), Order1:=xlAscending, Key2:=Range("b1"), Order2:=xlAscending, Header:=xlNo
        .Range("b:c").Delete
    End With
End Sub

【讨论】：