使用VBA宏对最后两位数进行排序

时间:2017-07-26 20:56:13

标签: vba excel-vba sorting numbers excel

我有一个包含大量5位数字列表的电子表格。我想用最后2位数组织这些数字。我有一个有效的配方,所以这不是我的问题。我的问题是,现在这些数字是按最后2位数组织的,有没有办法按所有5位数对这些数字进行排序?我的意思是这样的:我的数字现在按这样排序:

    12300
    15600
    12400
    15700
    12301
    15601
    12401
    15601 
    etc

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

    12300
    12400
    15600
    15700
    12301
    12401
    15601
    15701 
    etc 

这可能吗?

以下是将数字按最后两位数字排序的代码:

[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

2 个答案:

答案 0 :(得分:0)

您在上一条评论中的解决方案似乎很简单;这样做(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

答案 1 :(得分:0)

试试这段代码。

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