2017-07-26 41 views
0

我有一個包含5位數字的大型列表的電子表格。我想用最後兩位數字來組織這些數字。我有一個工作公式,這樣做,所以這不是我的問題。我現在的問題是,這些數字是由最後2位數字組織的,現在有什麼辦法可以按照所有5位數字對這些數字進行排序嗎?我的意思是這樣的:我現在的數字是有序的這樣的:使用VBA宏對最後兩位數字進行排序

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 
+1

創建一個3位數列和一個2位數列。先進的排序界面允許您先排序一列,然後排序。 –

+0

謝謝,我會這樣做的。 –

+0

對不起,約翰科爾曼,我不小心刪除了你的評論。我編輯了我的問題以包含代碼。 –

回答

0

您上次評論的解決方案似乎很簡單;這樣做同樣的事情(Sheet1中,柱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 
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