Function Sort2DArray(ByVal Source2D, ByVal HasTitle As Boolean, ByVal ColIndex As Integer, _
Optional ByVal Order As Boolean = True, Optional ByVal ShowTitle As Boolean = True)
'Sort theo 1 dieu kien, voi ColIndex là thu tu cot Sort dem tu cot dau tien
Dim List As Object, Darr(), Arr(), SameArr(), tmp
Dim i As Long, j As Long, idx As Long, lPos As Long
Dim FistR As Integer, LastR As Long, FistC As Integer, LastC As Integer
On Error GoTo Thoat
Const Test_Source2D = 1
If Test_Source2D = 2 Then
Thoat:
MsgBox ("Source2D hoac các ColIndex khong dung" & Chr(13) & "Sort Data Khong duoc thuc hien")
Sort2DArray = Source2D
Exit Function
End If
Darr = Source2D
FistR = LBound(Darr, 1): LastR = UBound(Darr, 1)
FistC = LBound(Darr, 2): LastC = UBound(Darr, 2)
Col = FistC + ColIndex - 1
If HasTitle = False Then ShowTitle = True
Set List = CreateObject("System.Collections.ArrayList")
For i = FistR - HasTitle To LastR
tmp = Darr(i, Col)
If IsNumeric(tmp) Then tmp = CStr(String(15 - Len(CStr(tmp)), "0") & tmp)
List.Add tmp
Next
List.Sort
If Not Order Then List.Reverse
If ShowTitle Then
ReDim Arr(FistR To LastR, FistC To LastC)
If HasTitle Then
For j = FistC To LastC
Arr(FistR, j) = Darr(FistR, j)
Next j
End If
Else
ReDim Arr(FistR To LastR + HasTitle, FistC To LastC)
End If
ReDim SameArr(List.Count - 1)
For i = FistR - HasTitle To LastR
tmp = Darr(i, Col)
If IsNumeric(tmp) Then tmp = CStr(String(15 - Len(CStr(tmp)), "0") & tmp)
idx = List.IndexOf(tmp, 0)
lPos = idx + FistR + SameArr(idx)
If ShowTitle Then lPos = lPos - HasTitle
For j = FistC To LastC
Arr(lPos, j) = Darr(i, j)
Next
SameArr(idx) = SameArr(idx) + 1
Next
Sort2DArray = Arr
Set List = Nothing
End Function
Function SortArray(ByVal Source2D, ByVal HasTitle As Boolean, ByVal ColIndex1 As Integer, _
Optional ByVal Order1 As Boolean = True, Optional ByVal ColIndex2 As Integer = -1245, _
Optional ByVal Order2 As Boolean = True, Optional ByVal ColIndex3 As Integer = -1245, _
Optional ByVal Order3 As Boolean = True, Optional ByVal ShowTitle As Boolean = True)
'Sort theo toi da 3 cot
Dim Darr(), Scol As Integer
On Error GoTo Thoat
Const Test_Source2D = 1
If Test_Source2D = 2 Then
Thoat:
MsgBox ("Source2D hoac các ColIndex khong dung" & Chr(13) & "Sort Data Khong duoc thuc hien")
SortArray = Source2D
Exit Function
End If
Darr = Source2D
Scol = UBound(Darr, 2) - LBound(Darr, 2) + 1 'So cot du lieu
If ColIndex1 >= 1 And ColIndex1 <= Scol Then
Darr = Sort2DArray(Darr, HasTitle, ColIndex1, Order1, ShowTitle)
If ColIndex2 >= 1 Then
If ColIndex2 <= Scol Then
Darr = SortArray2Col(Darr, ColIndex1, ColIndex1, ColIndex2, Order2, HasTitle, ShowTitle)
If ColIndex3 >= 1 And ColIndex3 <= Scol Then
Darr = SortArray2Col(Darr, ColIndex1, ColIndex2, ColIndex3, Order3, HasTitle, ShowTitle)
ElseIf ColIndex3 <> -1245 Then
GoTo Thoat
End If
ElseIf ColIndex2 <> -1245 Then
GoTo Thoat
End If
End If
SortArray = Darr
Else
GoTo Thoat
End If
End Function
Function SortArray2Col(ByVal Source2D, ByVal ColMain1 As Integer, ByVal ColMain2 As Integer, _
ByVal ColIndex As Integer, ByVal Order As Boolean, ByVal HasTitle As Boolean, ByVal ShowTitle As Boolean)
Dim Darr(), Arr()
Dim i As Long, ir As Long, K As Long, StarR As Long, j As Integer, Tmp1, Tmp2
Dim FistR As Integer, LastR As Long, FistC As Integer, LastC As Integer
Darr = Source2D
FistR = LBound(Darr, 1): LastR = UBound(Darr, 1)
FistC = LBound(Darr, 2): LastC = UBound(Darr, 2)
Col1 = FistC + ColMain1 - 1
Col2 = FistC + ColMain2 - 1
For i = FistR - HasTitle To LastR - 1
If Darr(i, Col1) = Darr(i + 1, Col1) And Darr(i, Col2) = Darr(i + 1, Col2) Then
StarR = i
Tmp1 = Darr(i, Col1): Tmp2 = Darr(i, Col2)
K = 0
For ir = StarR To LastR
If Darr(ir, Col1) = Tmp1 And Darr(ir, Col2) = Tmp2 Then
K = K + 1
Else
Exit For
End If
Next ir
ReDim Arr(1 To K, FistC To LastC)
For ir = 1 To K
For j = FistC To LastC
Arr(ir, j) = Darr(StarR + ir - 1, j)
Next j
Next ir
Arr = Sort2DArray(Arr, False, ColIndex, Order, True)
For ir = 1 To K
For j = FistC To LastC
Darr(StarR + ir - 1, j) = Arr(ir, j)
Next j
Next ir
i = i + K - 1
End If
Next i
SortArray2Col = Darr
End Function