Function Sort2DArray(ByVal SourceArray, ByVal ColIndex As Long, ByVal Order As Boolean, ByVal HasTitle As Boolean)
Dim tmpArr, i As Long, j As Long, SortArr, Item1, Item2, firstVal As Double
Dim Arr, iR As Long, tmp(), n As Long, Chk As Boolean
On Error Resume Next
tmpArr = SourceArray: Arr = tmpArr
ColIndex = ColIndex + LBound(tmpArr, 2) - 1
firstVal = CDbl(tmpArr(LBound(tmpArr, 1) - HasTitle, ColIndex))
Chk = firstVal > 0
For i = LBound(tmpArr, 1) - HasTitle To UBound(tmpArr, 1)
ReDim Preserve tmp(n)
If Chk Then
tmp(n) = CDbl(tmpArr(i, ColIndex))
Else
tmp(n) = CStr(tmpArr(i, ColIndex))
End If
n = n + 1
Next
SortArr = Sort1DArray(tmp, Order)
With CreateObject("Scripting.Dictionary")
For i = LBound(SortArr) To UBound(SortArr)
If Chk Then
If Not .Exists(CDbl(SortArr(i))) Then .Add CDbl(SortArr(i)), i + LBound(tmpArr, 1) - HasTitle
Else
If Not .Exists(CStr(SortArr(i))) Then .Add CStr(SortArr(i)), i + LBound(tmpArr, 1) - HasTitle
End If
Next
For i = LBound(tmpArr, 1) - HasTitle To UBound(tmpArr, 1)
If Chk Then
iR = .Item(CDbl(tmpArr(i, ColIndex)))
Else
iR = .Item(CStr(tmpArr(i, ColIndex)))
End If
For j = LBound(tmpArr, 2) To UBound(tmpArr, 2)
Arr(iR, j) = tmpArr(i, j)
Next
If Chk Then
.Item(CDbl(tmpArr(i, ColIndex))) = iR + 1
Else
.Item(CStr(tmpArr(i, ColIndex))) = iR + 1
End If
Next
End With
Sort2DArray = Arr
End Function
Function Sort1DArray(ByVal srcArr, ByVal Order As Boolean)
Dim Item, tmpArr, Arr1, Arr2, n As Long, m As Long
tmpArr = srcArr
With CreateObject("System.Collections.ArrayList")
For Each Item In tmpArr
.Add Item
Next
.Sort
Arr1 = .ToArray
If Order = False Then
ReDim Arr2(LBound(Arr1) To UBound(Arr1))
For n = .Count To 1 Step -1
Arr2(m) = Arr1(n - 1)
m = m + 1
Next
Sort1DArray = Arr2
Else
Sort1DArray = Arr1
End If
End With
End Function
Function Unique2DArray(ByVal SourceArray, Optional ByVal ColIndex As Variant = 1)
Dim aSrc, aCol, tmp As String, cItem
Dim lR As Long, lC As Long, lUB1 As Long, lUB2 As Long, lLB1 As Long, lLB2 As Long, n As Long
Dim dic As Object
Set dic = CreateObject("Scripting.Dictionary")
aSrc = SourceArray: aCol = ColIndex
If Not IsArray(aCol) Then aCol = Array(aCol)
lLB1 = LBound(aSrc, 1): lLB2 = LBound(aSrc, 2)
lUB1 = UBound(aSrc, 1): lUB2 = UBound(aSrc, 2)
ReDim aDes(1 To lUB2 + 1 - lLB2, 1 To 1)
For lR = lLB1 To lUB1
tmp = vbNullString
If Len(CStr(aSrc(lR, 1))) Then
For Each cItem In aCol
tmp = tmp & vbBack & aSrc(lR, cItem)
Next
If Not dic.Exists(tmp) Then
n = n + 1
dic.Add tmp, lR
ReDim Preserve aDes(1 To lUB2 + 1 - lLB2, 1 To n)
For lC = lLB2 To lUB2
aDes(lC, n) = aSrc(lR, lC)
Next
End If
End If
Next
If n Then Unique2DArray = Transpose2DArray(aDes)
End Function
Function Transpose2DArray(ByVal SourceArray)
Dim aSrc
Dim lR As Long, lC As Long
aSrc = SourceArray
ReDim aDes(LBound(aSrc, 2) To UBound(aSrc, 2), LBound(aSrc, 1) To UBound(aSrc, 1))
For lR = LBound(aSrc, 1) To UBound(aSrc, 1)
For lC = LBound(aSrc, 2) To UBound(aSrc, 2)
aDes(lC, lR) = aSrc(lR, lC)
Next
Next
Transpose2DArray = aDes
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.
