請教資料依2欄排序

morris0914

有個排序問題麻煩幫忙~~
E欄14到16945開始排序從小到大，
D14到16945開始遇到E欄遇0為從小到大，遇到E欄為1則從大到小，遇到E欄為2則從小到大，
遇到E欄為3則從小到大，依此類推，而且其它例資料也需跟著移動，資料如附件。

Hsieh

回復 1# morris0914

依你所述，只有E欄為1時排序才由大到小
所以，只要先把所有資料依據E欄為主要鍵，D欄為次要鍵由小到大(遞增)排序後
再篩選出E欄為1的資料，然後依照D欄由大到小(遞減)排序
   

下載 (855.91 KB)

2012-7-18 14:24

morris0914

回復 2# Hsieh


    感謝你的幫忙，另外請教如果E欄有300筆，就需作300次，如果用VBA要如何寫，在下是用巨集跑，如何縮短程式(如下，只跑四筆資料)，謝謝。

Sub Macro2()
'
' Macro2 Macro
' 11 在 2012/7/18 錄製的巨集
    Rows("13:13").Select
    Selection.AutoFilter
    Range("A13:AF16945").Sort Key1:=Range("E13"), Order1:=xlAscending, Header _
        :=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom _
        , SortMethod:=xlStroke, DataOption1:=xlSortNormal
    Selection.AutoFilter Field:=5, Criteria1:="0"
    Range("A13:AF16945").Sort Key1:=Range("D13"), Order1:=xlAscending, Header _
        :=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom _
        , SortMethod:=xlStroke, DataOption1:=xlSortNormal
    Selection.AutoFilter Field:=5, Criteria1:="1"
    Range("A13:AF16945").Sort Key1:=Range("D13"), Order1:=xlDescending, Header _
        :=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom _
        , SortMethod:=xlStroke, DataOption1:=xlSortNormal
    Selection.AutoFilter Field:=5, Criteria1:="2"
    Range("A13:AF16945").Sort Key1:=Range("D13"), Order1:=xlAscending, Header _
        :=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom _
        , SortMethod:=xlStroke, DataOption1:=xlSortNormal
    Selection.AutoFilter Field:=5, Criteria1:="3"
    Range("A13:AF16945").Sort Key1:=Range("D13"), Order1:=xlDescending, Header _
        :=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom _
        , SortMethod:=xlStroke, DataOption1:=xlSortNormal
    Selection.AutoFilter Field:=5, Criteria1:="4"
    Range("A13:AF16945").Sort Key1:=Range("D13"), Order1:=xlAscending, Header _
        :=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom _
        , SortMethod:=xlStroke, DataOption1:=xlSortNormal
    Selection.AutoFilter Field:=5
    Selection.AutoFilter
End Sub

Hsieh

回復 3# morris0914
不懂你D欄遞增或遞減的判斷規則如何?
應該是0或偶數的E欄為遞增，奇數則遞減
如果是這樣，試試以下程式碼

1. Sub nn()
   
2. Dim Rng As Range, Rng1 As Range
   
3. Set Rng = Range("A10").CurrentRegion
   
4. x = Application.Min(Rng.Columns(5))
   
5. y = Application.Max(Rng.Columns(5))
   
6. For i = x To y
   
7. Rng.AutoFilter Field:=5, Criteria1:=i
   
8. k = i Mod 2
   
9. Set Rng1 = Rng.Offset(1).SpecialCells(xlCellTypeVisible)
   
10. Rng1.SpecialCells(xlCellTypeConstants).Sort key1:=Rng1.Cells(1, 4), order1:=k + 1, header:=xlGuess
    
11. Rng.AutoFilter
    
12. Next
    
13. End Sub

複製代碼

morris0914

回復 4# Hsieh


    感謝板主的指導，我再試試看，謝謝。