Function StrSort(ByVal Text As String, ByVal Delimiter As String, Optional ByVal Order As Boolean = False) As String
Dim aTmp, item, strDes As String
Dim n As Long
On Error Resume Next
aTmp = Split(Text, Delimiter)
ReDim arr(1 To 1)
For Each item In aTmp
n = CLng(Trim(item))
If n > UBound(arr) Then ReDim Preserve arr(1 To n)
arr(n) = arr(n) & " " & IIf(Order, StrReverse(n), n)
Next
strDes = WorksheetFunction.Trim(Join(arr, " "))
If Order Then strDes = StrReverse(strDes)
StrSort = Replace(strDes, " ", Delimiter)
End FunctionThuật toán của anh hay quá, vượt xa cách em suy nghĩ. Em thì phải mược thêm cái Dic nữa mới xong. Chỉ vọc chơi thôi chứ dễ gì có dịp xài mấy dạng code này đâu.
Theo mình thì chắc không code nổi đâu. Nếu vì lý do gì đó cần phải Sort trong mảng thì viết cái hàm Sort tạm thôi. Với dữ liệu ít thì được chứ nếu dữ liệu nhiều chạy treo máy luôn.
Sub Sort_Array()
Dim Sarr(), SortCol As Byte
SortCol = 1
Sarr = Range([A1], [A65536].End(3)).Resize(, 10).Value
[A1].Resize(UBound(Sarr), UBound(Sarr, 2)) = Sort_In_Arr(Sarr, SortCol)
End Sub
Function Sort_In_Arr(Sarr As Variant, Col As Byte) As Variant
Dim i As Long, j As Long, X As Long
Dim Temp(), Changed As Boolean
ReDim Temp(1 To 1, 1 To UBound(Sarr, 2))
For i = 1 To UBound(Sarr) - 1
Changed = False
For j = 1 To UBound(Sarr) - 1
If Sarr(j, Col) > Sarr(j + 1, Col) Then
For X = 1 To UBound(Sarr, 2)
Temp(1, X) = Sarr(j, X)
Sarr(j, X) = Sarr(j + 1, X)
Sarr(j + 1, X) = Temp(1, X)
Next
Changed = True
End If
Next
If Changed = False Then Exit For
Next
Sort_In_Arr = Sarr
End Function
