Sắp xếp mảng dữ liệu không sử dụng vòng lặp

rollover79

Thành viên tiêu biểu
Tham gia ngày
10 Tháng chín 2008
Bài viết
764
Được thích
1,303
Điểm
860
Xin gửi các bạn 1 hàm sắp xếp mảng dữ liệu không sử dụng vòng lặp. arr là mảng cần sắp xếp, isText=true là sắp xếp mảng kiểu chuỗi, ngược lại là kiểu số(mặc định là kiểu số), isDESC=true là sắp xếp giảm dần, ngược lại là tăng dần(mặc định là tăng dần).
Đây là thủ thuật lợi dụng tính năng sắp xếp có sẵn trên ngôn ngữ khác(JavaScript) để thực hiện, có hạn chế là phải chuyển qua 1 chuỗi trung gian nên khi trả về luôn là mảng chuỗi, thích hợp cho việc hiển thị, còn dùng để tính toán thì sẽ có hạn chế. Về tốc độ thì tôi chưa test kỹ, nhưng có vẻ khả quan hơn phương pháp sử dụng vòng lặp thông thường.
Mã:
Public Function SortArray(arr, Optional isText As Boolean = False, Optional isDESC As Boolean = False)
    Dim sCommand As String
    sCommand = "('" & Join(arr, vbBack) & "').split('" & vbBack & "').sort("
    If isText Then
        sCommand = sCommand & ")"
    Else
        sCommand = sCommand & "function(a,b){return (a-b)})"
    End If
    If isDESC Then sCommand = sCommand & ".reverse()"
    sCommand = sCommand & ".join('" & vbBack & "')"
    Dim objSC
    Set objSC = CreateObject("MSScriptControl.ScriptControl")
    objSC.Language = "JavaScript"
    SortArray = Split(objSC.Eval(sCommand), vbBack)
End Function
 

ndu96081631

Huyền thoại GPE
Thành viên BQT
Super Moderator
Tham gia ngày
5 Tháng sáu 2008
Bài viết
30,689
Được thích
53,439
Điểm
11,910
Xin gửi các bạn 1 hàm sắp xếp mảng dữ liệu không sử dụng vòng lặp. arr là mảng cần sắp xếp, isText=true là sắp xếp mảng kiểu chuỗi, ngược lại là kiểu số(mặc định là kiểu số), isDESC=true là sắp xếp giảm dần, ngược lại là tăng dần(mặc định là tăng dần).
Đây là thủ thuật lợi dụng tính năng sắp xếp có sẵn trên ngôn ngữ khác(JavaScript) để thực hiện, có hạn chế là phải chuyển qua 1 chuỗi trung gian nên khi trả về luôn là mảng chuỗi, thích hợp cho việc hiển thị, còn dùng để tính toán thì sẽ có hạn chế. Về tốc độ thì tôi chưa test kỹ, nhưng có vẻ khả quan hơn phương pháp sử dụng vòng lặp thông thường.
Mã:
Public Function SortArray(arr, Optional isText As Boolean = False, Optional isDESC As Boolean = False)
    Dim sCommand As String
    sCommand = "('" & Join(arr, vbBack) & "').split('" & vbBack & "').sort("
    If isText Then
        sCommand = sCommand & ")"
    Else
        sCommand = sCommand & "function(a,b){return (a-b)})"
    End If
    If isDESC Then sCommand = sCommand & ".reverse()"
    sCommand = sCommand & ".join('" & vbBack & "')"
    Dim objSC
    Set objSC = CreateObject("MSScriptControl.ScriptControl")
    objSC.Language = "JavaScript"
    SortArray = Split(objSC.Eval(sCommand), vbBack)
End Function
Vừa test xong, sort 60.000 dòng dữ liệu mất 5 giây!
Hơi bị ấn tượng đấy ---> Dùng phương pháp sort thông thường thì... ẹc... ẹc... bấm nút... đi uống cafe xong quay về là vừa...
Nói thêm: 5 giây này là tổng thời gian, có dùng hàm TRANSPOSE (vì phải chuyển mảng 1 chiều thành 2 chiều) ---> Nếu bỏ luôn TRANSPOSE thì chắc còn nhanh hơn nữa
 
Lần chỉnh sửa cuối:

anhdepjai

Thành viên thường trực
Tham gia ngày
16 Tháng sáu 2010
Bài viết
322
Được thích
63
Điểm
695
Tuổi
36
Sub test()


dArr = Sheet3.Range("H2:H1056")
dArr = SortArray(dArr, False, True)


End Sub

Các bác cho em hỏi, sao chạy code này nó báo lỗi chỗ dòng

sCommand = "('" & Join(Arr, vbBack) & "').split('" & vbBack & "').sort("

nhỉ

Thanks
 

ndu96081631

Huyền thoại GPE
Thành viên BQT
Super Moderator
Tham gia ngày
5 Tháng sáu 2008
Bài viết
30,689
Được thích
53,439
Điểm
11,910
Sub test()


dArr = Sheet3.Range("H2:H1056")
dArr = SortArray(dArr, False, True)


End Sub

Các bác cho em hỏi, sao chạy code này nó báo lỗi chỗ dòng

sCommand = "('" & Join(Arr, vbBack) & "').split('" & vbBack & "').sort("

nhỉ

Thanks
Hàm trên là dùng để sort mảng 1 chiều bạn à!
 

anhdepjai

Thành viên thường trực
Tham gia ngày
16 Tháng sáu 2010
Bài viết
322
Được thích
63
Điểm
695
Tuổi
36
Hic

Vậy mà e cứ tưởng range theo 1 cột là mảng 1 chiều. Vậy nếu là range theo cột có chuyển thành mảng 1 chiều được không thầy.
 
Top Bottom