Board logo

標題: 請教資料依2欄排序 [打印本頁]
作者: morris0914    時間: 2012-7-18 13:55     標題: 請教資料依2欄排序

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

回復 1# morris0914

依你所述，只有E欄為1時排序才由大到小
所以，只要先把所有資料依據E欄為主要鍵，D欄為次要鍵由小到大(遞增)排序後
再篩選出E欄為1的資料，然後依照D欄由大到小(遞減)排序
   [attach]11727[/attach]
作者: morris0914    時間: 2012-7-18 14:59

回復 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    時間: 2012-7-18 19:19

回復 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    時間: 2012-7-19 09:27

回復 4# Hsieh


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



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)