Maika8008
Thành viên gạo cội
- Tham gia
- 12/6/20
- Bài viết
- 4,741
- Được thích
- 5,669
- Donate (Momo)
- Giới tính
- Nam
Sau khi được gợi ý của @HieuCD về việc dùng Arraylist từ các bài viết của @befaint, tôi cố vận dụng mọi thứ mà tôi có về VBA để giải quyết việc dùng Arraylist (nguyên là để sắp xếp mảng 1 chiều) để sắp xếp mảng 2 chiều. Tất nhiên với khả năng tay ngang của tôi thì chưa đi đến tận cùng của vấn đề nên đôi chỗ sắp xếp vẫn không như ý, không đúng trình tự sắp xếp của Excel. Tôi chia sẻ lên đây mong nhận nhiều góp ý để hoàn thiện code.
Có 2 hàm: 1 cho việc sắp xếp 1 cột và 1 cho việc sắp thêm cột thứ 2. Hàm 2 gọi hàm 1 cho tiện (thiển ý của tôi là vậy). Code chạy nhanh do tận dụng được tốc độ của Arraylist và hàm Split.
Hàm này không dùng để gõ trực tiếp trên trang tính được mà chỉ dùng làm công cụ trung gian trong lập trình xử lý các vấn đề có liên quan đến mảng dữ liệu. File ví dụ kèm theo dành cho ai muốn thử hàm.
Update: Tôi đã giải quyết vấn đề sắp xếp cột số không cùng kích thước.
Có 2 hàm: 1 cho việc sắp xếp 1 cột và 1 cho việc sắp thêm cột thứ 2. Hàm 2 gọi hàm 1 cho tiện (thiển ý của tôi là vậy). Code chạy nhanh do tận dụng được tốc độ của Arraylist và hàm Split.
Hàm này không dùng để gõ trực tiếp trên trang tính được mà chỉ dùng làm công cụ trung gian trong lập trình xử lý các vấn đề có liên quan đến mảng dữ liệu. File ví dụ kèm theo dành cho ai muốn thử hàm.
Update: Tôi đã giải quyết vấn đề sắp xếp cột số không cùng kích thước.
Mã:
Function SortInArray(ByRef SortArray As Variant, Optional lngColumn As Long = 0, _
Optional ByVal Order As Boolean = True)
On Error Resume Next
Dim arrTemp, arrRsl, arrRsl2
Dim ArrList As Object, i As Long, j As Long, k As Long, m As Long, NumVal As Double
Set ArrList = CreateObject("System.Collections.ArrayList")
arrTemp = SortArray
ReDim Preserve arrTemp(1 To UBound(SortArray, 1), 1 To UBound(SortArray, 2) + 1)
For i = LBound(SortArray, 1) To UBound(SortArray, 1)
arrTemp(i, UBound(SortArray, 2) + 1) = IIf(IsNumeric(SortArray(i, lngColumn)), Right("00000" & SortArray(i, lngColumn), 6), SortArray(i, lngColumn)) & "|" 'Update 13h58 -10/5/21
For j = LBound(SortArray, 2) To lngColumn - 1
arrTemp(i, UBound(SortArray, 2) + 1) = arrTemp(i, UBound(SortArray, 2) + 1) & SortArray(i, j) & "|"
Next
For j = lngColumn + 1 To UBound(SortArray, 2)
arrTemp(i, UBound(SortArray, 2) + 1) = arrTemp(i, UBound(SortArray, 2) + 1) & SortArray(i, j) & "|"
Next
ArrList.Add CStr(arrTemp(i, UBound(SortArray, 2) + 1))
Next
ArrList.Sort
If Order = False Then ArrList.Reverse
ReDim arrRsl2(1 To UBound(SortArray, 1), 1 To UBound(SortArray, 2))
For i = LBound(SortArray, 1) - 1 To UBound(SortArray, 1) - 1
arrRsl = Split(ArrList.Item(i), "|")
For j = LBound(SortArray, 2) To lngColumn - 1
arrRsl2(i + 1, j) = arrRsl(j)
Next
arrRsl2(i + 1, lngColumn) = arrRsl(0)
For j = lngColumn + 1 To UBound(SortArray, 2)
arrRsl2(i + 1, j) = arrRsl(j - 1)
Next
Next
SortInArray = arrRsl2
Set ArrList = Nothing
End Function
Function SortInArray2(ByRef SortArray As Variant, Optional lngColumn As Long = 0, Optional Order As Boolean = True, _
Optional lngColumn2 As Long = 0, Optional Order2 As Boolean = True)
Dim SortArr As Variant
Dim i As Long, j As Long, k As Long, D As Long, r As Long
If lngColumn = 0 Then lngColumn = 1
SortArray = SortInArray(SortArray, lngColumn, Order)
ReDim TempArray(1 To UBound(SortArray, 1), 1 To UBound(SortArray, 2))
For i = LBound(SortArray, 1) To UBound(SortArray, 1)
k = k + 1
On Error Resume Next
If SortArray(i, lngColumn) <> SortArray(i + 1, lngColumn) Then
If Err.Number = 9 Then
On Error GoTo 0
GoTo Sort
End If
Sort: If k > 1 Then
ReDim SortArr(1 To k, 1 To UBound(SortArray, 2))
For r = 1 To k
For j = LBound(SortArray, 2) To UBound(SortArray, 2)
SortArr(r, j) = SortArray(i - k + r, j)
Next
Next
SortArr = SortInArray(SortArr, lngColumn2, Order2)
For D = i - k + 1 To i
For j = LBound(SortArray, 2) To UBound(SortArray, 2)
SortArray(D, j) = SortArr(D + k - i, j)
Next
Next
k = 0
Else
k = 0
End If
End If
Next
SortInArray2 = SortArray
End Function
Lần chỉnh sửa cuối:
