Tặng các bạn thủ tục SORT với rất nhiều cột trong bảng tính (1 người xem)

Hoàng Trọng Nghĩa · 30/10/15

Tôi viết cái này dựa theo ghi lại Macro việc SORT nhiều cột. Thủ tục này chỉ thực hiện trên Excel 2007 trở về sau.

Thủ tục chính:

Mã:

Sub MultiSort(ByVal SheetName As String, _
              ByVal SortRange As Range, _
              ByVal ColumnName As String, _
     Optional ByVal SortType As Boolean, _
     Optional ByVal Header As Boolean)
    Dim splArr
    Dim c As Long
    Dim WS As Worksheet
    ColumnName = UCase(Replace(ColumnName, " ", ""))
    splArr = Split(ColumnName, ",")
    Set WS = Worksheets(SheetName)
    WS.Sort.SortFields.Clear
    For c = 0 To UBound(splArr)
        WS.Sort.SortFields.Add _
        Key:=Range(splArr(c) & 1), _
        SortOn:=xlSortOnValues, _
        Order:=IIf(SortType, xlDescending, xlAscending), _
        DataOption:=xlSortNormal
    Next
    With WS.Sort
        .SetRange SortRange
        .Header = IIf(Header, xlYes, xlNo)
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Với SortType và Header, mặc định là False nếu ta không ghi gì vào đó, có nghĩa là: SortType = False tức Sort từ nhỏ tới lớn và ngược lại, SortType = True là Sort từ lớn đến nhỏ. Còn Header = False tức không có tiêu đề cột và ngược lại Còn Header = True là có tiêu đề cột (để tránh việc sort luôn cái tiêu đề).

Thủ tục chính để thực hiện:

Mã:

Sub Test()
      MultiSort "Sheet1", Range("D8:I18"), "E,F,G,H,I", True, True
End Sub

Như thế, tên sheet ta ghi dạng chuỗi, tên cột ghi bằng chuỗi có cấu trúc như màu cam ("E,F,G,H,I"), cột nào ưu tiên trước thì để trước dần dần cho tới sau. Cách nhau bằng dầu phẩy (,) có khoảng trắng cũng được, không cũng được.

Số cột và tên cột cần sắp xếp phải phù hợp vùng cần sắp xếp, chứ không thể vùng sắp xếp có 7 cột mà cột cần sắp xếp lại vượt quá 7, đồng thời tên cột không có cột A trong vùng sắp xếp lại đặt điều kiện có cột A trong đó cũng không được.

Xem cải tiến ở bài #9 của topic này:

http://www.giaiphapexcel.com/forum/showthread.php?109381-Tặng-các-bạn-thủ-tục-SORT-với-rất-nhiều-cột-trong-bảng-tính&p=684244#post684244

Hoàng Trọng Nghĩa · 30/10/15

Song có người lại hỏi, "Tôi muốn mỗi cột sort mỗi kiểu tùy vào hoàn cảnh thì tôi phải làm sao?"

Xin thưa tôi cũng có thủ tục cho cả trường hợp này nhé:

Mã:

Sub MultiChoiceSort(ByVal SheetName As String, _
                    ByVal SortRange As Range, _
                    ByVal ColumnName As String, _
           Optional ByVal Header As Boolean)
    Dim splArr
    Dim c As Long
    Dim WS As Worksheet
    ColumnName = UCase(Replace(ColumnName, " ", ""))
    splArr = Split(ColumnName, ",")
    Set WS = Worksheets(SheetName)
    WS.Sort.SortFields.Clear
    For c = 0 To UBound(splArr) Step 2
        WS.Sort.SortFields.Add _
        Key:=Range(splArr(c) & 1), _
        SortOn:=xlSortOnValues, _
        Order:=splArr(c + 1), _
        DataOption:=xlSortNormal
    Next
    With WS.Sort
        .SetRange SortRange
        .Header = IIf(Header, xlYes, xlNo)
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Cấu trúc thủ tục thực hiện như sau:

Mã:

Sub Test()
''Voi 1 la xlAscending va 2 la xlDescending
    MultiChoiceSort "Sheet1", Range("D8:I18"), "E,2,F,2,G,1,H,1,I,2", True
End Sub

Tức tên Cột đứng trước và cách thức Sort đứng sau và cứ thế, cách nhau là 1 dấu phẩy.

phulien1902 · 30/10/15

Office đời thấp quá, nên không có điều kiện để thử nghiệm ứng dụng của anh.

Cá ngừ F1 · 30/10/15

Hay quá anh Nghĩa đẹp trai.
Anh Bill anh ý chỉ hỗ trợ Sort tối đa có 3 cột (không biết phiên bản mới thế nào) anh cải tiến lên n cột.
Rất hay ạ!

ndu96081631 · 30/10/15

Hoàng Trọng Nghĩa đã viết:
Song có người lại hỏi, "Tôi muốn mỗi cột sort mỗi kiểu tùy vào hoàn cảnh thì tôi phải làm sao?"

Xin thưa tôi cũng có thủ tục cho cả trường hợp này nhé:

Mã:

Sub MultiChoiceSort([COLOR=#ff0000]ByVal SheetName As String[/COLOR], _ ByVal SortRange As Range, _ ByVal ColumnName As String, _ Optional ByVal Header As Boolean)

Đối số SheetName là thừa! Bời bản thân SortRange.Parent đã cho ta biết thông tin về SheetName rồi. Thậm chí SortRange.Parent.Parent cũng cho ta biết Workbook nào là "ông nội" của nó luôn

Hoàng Trọng Nghĩa · 30/10/15

ndu96081631 đã viết:
Đối số SheetName là thừa! Bời bản thân SortRange.Parent đã cho ta biết thông tin về SheetName rồi. Thậm chí SortRange.Parent.Parent cũng cho ta biết Workbook nào là "ông nội" của nó luôn

Nếu như ta muốn sort ở một sheet, nhưng sheet hiện hành là một sheet khác thì làm sao? Hoặc giả dụ ta chỉ sort ở trên Form, lúc này ta đâu có gọi sheet đó select?

Hoàng Trọng Nghĩa · 30/10/15

Tuy nhiên, ghi thế này cũng được: Sheet1.Range()

Nhưng như thế cũng là thêm tên sheet thôi.

Hay ý thầy nói, nếu không thêm màu đỏ thì được hiểu là sheet hiện hành, còn có thì theo Parent của Range đó?

Hoàng Trọng Nghĩa · 30/10/15

Em sẽ sửa lại theo gợi ý của Thầy!

Mã:

Sub MultiChoiceSort(ByVal SortRange As Range, _
                    ByVal ColumnName As String, _
           Optional ByVal Header As Boolean)
    Dim splArr
    Dim c As Long
    Dim WS As Worksheet
    Set WS = SortRange.Parent
    ColumnName = UCase(Replace(ColumnName, " ", ""))
    splArr = Split(ColumnName, ",")
    WS.Sort.SortFields.Clear
    For c = 0 To UBound(splArr) Step 2
        WS.Sort.SortFields.Add _
        Key:=Range(splArr(c) & 1), _
        SortOn:=xlSortOnValues, _
        Order:=splArr(c + 1), _
        DataOption:=xlSortNormal
    Next
    With WS.Sort
        .SetRange SortRange
        .Header = IIf(Header, xlYes, xlNo)
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub


Sub Test()
    ''Voi 1 la xlAscending, va 2 la xlDescending
    ''Sheet hien hanh:
    MultiChoiceSort Range("D8:I18"), "E,2,F,2,G,2,H,2,I,2", True
    ''Hoac:
    ''Goi dich danh ten sheet neu khong phai sheet hien hanh:
    'MultiChoiceSort Sheet1.Range("D8:I18"), "E,2,F,2,G,2,H,2,I,2", True
End Sub

Và:

Mã:

Sub MultiSort(ByVal SortRange As Range, _
              ByVal ColumnName As String, _
     Optional ByVal SortType As Boolean, _
     Optional ByVal Header As Boolean)
    Dim splArr
    Dim c As Long
    Dim WS As Worksheet
    Set WS = SortRange.Parent
    ColumnName = UCase(Replace(ColumnName, " ", ""))
    splArr = Split(ColumnName, ",")
    WS.Sort.SortFields.Clear
    For c = 0 To UBound(splArr)
        WS.Sort.SortFields.Add _
        Key:=Range(splArr(c) & 1), _
        SortOn:=xlSortOnValues, _
        Order:=IIf(SortType, xlDescending, xlAscending), _
        DataOption:=xlSortNormal
    Next
    With WS.Sort
        .SetRange SortRange
        .Header = IIf(Header, xlYes, xlNo)
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub


Sub Test1()
    MultiSort Sheet1.Range("D8:I18"), "E,F,G,H,I", True, True
End Sub

VetMini · 30/10/15

Hoàng Trọng Nghĩa đã viết:
Nếu như ta muốn sort ở một sheet, nhưng sheet hiện hành là một sheet khác thì làm sao? Hoặc giả dụ ta chỉ sort ở trên Form, lúc này ta đâu có gọi sheet đó select?

Object range luôn luôn có thuộc tính Parent cho biết cái sheet chứa nó. Bất kể sheet nào hiện hành.

Nguyễn Duy Tuân · 30/10/15

Cá ngừ F1 đã viết:
Hay quá anh Nghĩa đẹp trai.
Anh Bill anh ý chỉ hỗ trợ Sort tối đa có 3 cột (không biết phiên bản mới thế nào) anh cải tiến lên n cột.
Rất hay ạ!

Từ Excel 2007 trở lên là nhiều cột mà em.

Cá ngừ F1 · 30/10/15

Nguyễn Duy Tuân đã viết:
Từ Excel 2007 trở lên là nhiều cột mà em.

Đâu có đâu a Tuân nhỉ? E dùng bản 2010 mà.
nếu mà có chắc a Nghĩa ko vất vả làm thủ tục này. Hì.

Quang_Hải · 30/10/15

Cá ngừ F1 đã viết:
Đâu có đâu a Tuân nhỉ? E dùng bản 2010 mà.
nếu mà có chắc a Nghĩa ko vất vả làm thủ tục này. Hì.

Từ phiên bản 2007 trở lên là có thể Sort nhiều cột nhé. Cứ Record macro xem nha

Hoàng Trọng Nghĩa · 30/10/15

Cá ngừ F1 đã viết:
Đâu có đâu a Tuân nhỉ? E dùng bản 2010 mà.
nếu mà có chắc a Nghĩa ko vất vả làm thủ tục này. Hì.

Đúng là mình có công tìm ra tính quy luật, nhưng cũng không quá vất vả đâu.

Ghi macro, sau đó chọn khối ô cần Sort, vào Sort trong Menu Data, rồi Add Level cho mỗi điều kiện cột là ra mà em trai.

Cá ngừ F1 · 30/10/15

quanghai1969 đã viết:
Từ phiên bản 2007 trở lên là có thể Sort nhiều cột nhé. Cứ Record macro xem nha

Em nhớ mang máng code như sau:

[A1:E1].sort [A1],1,key2:=[B2],order2:=1,key3:=[E1],order3:=1,Header:=xlYes

cũng có thử thêm key4, key5...mà ko có được.

Quang_Hải · 30/10/15

Tham khảm cách Sort nhiều cột của mình. Thật ra đây chỉ là sự rút gọn sau khi record marco

PHP:

Sub SortMultiCols()
Dim SortRng As Range, Col(), j As Long
Col = Array(3, 1, 2, 0, 4)
Set SortRng = Range("A1", [A65536].End(3))
ActiveSheet.Sort.SortFields.Clear
With Worksheets("Sheet1").Sort
    For j = LBound(Col) To UBound(Col)
        .SortFields.Add SortRng.Offset(, Col(j))
    Next
   .SetRange SortRng.Resize(, 5)
   .Header = xlYes
   .Apply
End With
End Sub

Hoàng Trọng Nghĩa · 30/10/15

Cá ngừ F1 đã viết:
Em nhớ mang máng code như sau:

[A1:E1].sort [A1],1,key2:=[B2],order2:=1,key3:=[E1],order3:=1,Header:=xlYes

cũng có thử thêm key4, key5...mà ko có được.

Đúng là cấu trúc đó với Excel 2003 trở về trước, nhưng từ khi có Excel 2007 thì đã được nâng cấp rồi. Ghi lại macro nó có dạng như thế này nè em:

Mã:

Sub Macro1()
'
' Macro1 Macro
'


'
    Range("D8:I18").Select
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("E9:E18") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("F9:F18") _
        , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("G9:G18") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("H9:H18") _
        , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("I9:I18") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("D8:I18")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("F22").Select
End Sub

Quang_Hải · 30/10/15

Hoàng Trọng Nghĩa đã viết:

Đúng là cấu trúc đó với Excel 2003 trở về trước, nhưng từ khi có Excel 2007 thì đã được nâng cấp rồi. Ghi lại macro nó có dạng như thế này nè em:

Mã:

Sub Macro1()
'
' Macro1 Macro
'


'
    Range("D8:I18").Select
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("E9:E18") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("F9:F18") _
        , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("G9:G18") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("H9:H18") _
        , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("I9:I18") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("D8:I18")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("F22").Select
End Sub

Record ra thì dễ rồi, nhưng nhìn vào mớ mì tôm cua đó mà rút gọn như bài 16 cũng cần có chút đỉnh nội công à nghen

Hoàng Trọng Nghĩa · 30/10/15

quanghai1969 đã viết:
Record ra thì dễ rồi, nhưng nhìn vào mớ mì tôm cua đó mà rút gọn như bài 16 cũng cần có chút đỉnh nội công à nghen

Tự nhiên nhớ câu chuyện cây kim băng, ngày xưa chưa ai biết cái gọi là kim băng, tới khi có một nhà phát minh đưa ra và sáng chế bằng phát minh thì người ta mới ồ lên, cái đó dễ òm ai mà chả biết làm! $-\\/.$ $-\\/.$ $-\\/.$

Quang_Hải · 30/10/15

Cá ngừ F1 đã viết:
Em nhớ mang máng code như sau:

[A1:E1].sort [A1],1,key2:=[B2],order2:=1,key3:=[E1],order3:=1,Header:=xlYes

cũng có thử thêm key4, key5...mà ko có được.

Có lẻ Tú học nhiều quá rồi quên mất mấy cái căn bản chứ gì. Nhớ lại xem có 1 bài trước đây Tú cũng đã hỏi vụ này. Moi lại trong GPE thì sẽ thấy. Sure đó.

Cá ngừ F1 · 30/10/15

quanghai1969 đã viết:
Có lẻ Tú học nhiều quá rồi quên mất mấy cái căn bản chứ gì. Nhớ lại xem có 1 bài trước đây Tú cũng đã hỏi vụ này. Moi lại trong GPE thì sẽ thấy. Sure đó.

Dạ. Thế nên e mới nhớ mang máng. Hí hí )(&&@@

Tặng các bạn thủ tục SORT với rất nhiều cột trong bảng tính (1 người xem)

Người dùng đang xem chủ đề này

Chuyên gia GPE

File đính kèm

Chuyên gia GPE

GPE - My love

( ͡° ͜ʖ ͡°)

Huyền thoại GPE

Chuyên gia GPE

Chuyên gia GPE

Chuyên gia GPE

Ăn cùng góc phố

Nghị Hách

( ͡° ͜ʖ ͡°)

Thành viên gạo cội

Chuyên gia GPE

( ͡° ͜ʖ ͡°)

Thành viên gạo cội

Chuyên gia GPE

Thành viên gạo cội

Chuyên gia GPE

Thành viên gạo cội

( ͡° ͜ʖ ͡°)

Đếm ngược thời gian