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
, Thầy Ba Tê đã giúp em code lọc không trùng bằng DIC ra Mảng Arr, rồi nạp Mảng Arr đó vào ListBox, nhưng chưa Sort tăng dần. Bây giờ em muốn mọi người giúp em Sort mảng Arr tăng dần rồi nạp vào ListBox.
