Sub Main()
Dim Darr()
Darr = Range("A1:E" & Range("B" & Rows.Count).End(xlUp).Row).Value
Arr = SortArray(Darr, True, 2, True, 3, True, 4, True)
Range("G1").Resize(UBound(Darr), UBound(Darr, 2)) = Arr
End Sub
Function SortArray(ByVal SourceArray, ByVal HasTitle As Boolean, ByVal ColIndex1 As Byte, _
Optional ByVal Order1 As Boolean = True, Optional ByVal ColIndex2 As Byte = 0, _
Optional ByVal Order2 As Boolean = True, Optional ByVal ColIndex3 As Byte = 0, _
Optional ByVal Order3 As Boolean = True)
Dim Darr(), Arr()
Dim i As Long, iP As Long, ir As Long, k As Long, R As Long, LenR As Byte, Tmp
Darr = SourceArray
ReDim Arr(1 To UBound(Darr), 1 To UBound(Darr, 2))
If ColIndex1 >= 1 And ColIndex1 <= UBound(Darr, 2) Then
If ColIndex2 = 0 Then
Arr = SortArray1Col(Darr, ColIndex1, Order1, HasTitle, True)
Else
Arr = SortArray1Col(Darr, ColIndex1, Order1, HasTitle)
If ColIndex2 >= 1 And ColIndex2 <= UBound(Darr, 2) Then
Darr = Arr
Arr = SortArray2Col(Darr, ColIndex1, ColIndex2, Order2, HasTitle)
If ColIndex3 >= 1 And ColIndex3 <= UBound(Darr, 2) Then
Darr = Arr
Arr = SortArray2Col(Darr, ColIndex2, ColIndex3, Order3, HasTitle)
End If
End If
End If
SortArray = Arr
End If
End Function
Function SortArray1Col(ByVal SourceArray, ByVal ColIndex As Byte, Optional ByVal Order As Boolean = True, _
Optional ByVal HasTitle As Boolean = False, Optional ByVal HideTitle As Boolean = False)
Dim IndexList As Object, List As Object, Darr(), Arr()
Dim i As Long, j As Byte, k As Long, R As Long, LenR As Integer, Tmp
Set IndexList = CreateObject("System.Collections.ArrayList")
Darr = SourceArray
R = UBound(Darr) + HasTitle 'so dong du lieu Sort
LenR = Len(CStr(R)) 'so chu so cua thu tu dong
If ColIndex < 1 Or ColIndex > UBound(Darr, 2) Then
MsgBox ("ColIndex khong phu hop" & Chr(13) & "Sort Data Khong duoc thuc hien")
SortArray1Col = Darr
Exit Function
End If
For i = 1 To R
Tmp = Darr(i - HasTitle, ColIndex)
If IsNumeric(Tmp) Then Tmp = CStr(String(15 - Len(CStr(Tmp)), "0") & Tmp)
Tmp = Tmp & String(LenR - Len(CStr(i)), "0") & i
IndexList.Add Tmp
Next
Set List = IndexList.Clone
List.Sort
ReDim Arr(1 To UBound(Darr), 1 To UBound(Darr, 2))
If HasTitle = False Then HideTitle = False
If HideTitle Then
ReDim Arr(1 To R, 1 To UBound(Darr, 2))
Else
ReDim Arr(1 To UBound(Darr), 1 To UBound(Darr, 2))
If HasTitle Then
For j = 1 To UBound(Darr, 2)
Arr(1, j) = Darr(1, j)
Next j
End If
End If
For i = 0 To R - 1
k = IndexList.InDexOf(List(i), 0) + 1
For j = 1 To UBound(Darr, 2)
If Order Then n = i + 1 Else n = R - i
If HideTitle Then
Arr(n, j) = Darr(k - HasTitle, j)
Else
Arr(n - HasTitle, j) = Darr(k - HasTitle, j)
End If
Next j
Next i
SortArray1Col = Arr
End Function
Function SortArray2Col(ByVal SourceArray, ByVal ColMain As Byte, ByVal ColIndex As Byte, ByVal Order As Boolean, Optional ByVal HasTitle As Boolean = False)
Dim Darr(), Arr()
Dim i As Long, ir As Long, k As Long, R As Long, j As Integer, Tmp
Darr = SourceArray
For i = 1 - HasTitle To UBound(Darr) - 1
If Darr(i, ColMain) = Darr(i + 1, ColMain) Then
R = i
Tmp = Darr(i, ColMain)
k = 0
For ir = R To UBound(Darr)
If Darr(ir, ColMain) = Tmp Then
k = k + 1
Else
Exit For
End If
Next ir
ReDim Arr(1 To k, 1 To UBound(Darr, 2))
For ir = 1 To k
For j = 1 To UBound(Darr, 2)
Arr(ir, j) = Darr(ir + R - 1, j)
Next j
Next ir
Arr = SortArray1Col(Arr, ColIndex, Order)
For ir = 1 To k
For j = 1 To UBound(Darr, 2)
Darr(ir + R - 1, j) = Arr(ir, j)
Next j
Next ir
i = i + k - 1
End If
Next i
SortArray2Col = Darr
End Function