Sort trong mảng Arr

Liên hệ QC

NguyenthiH

Thành viên mới đăng ký
Tham gia
11/12/16
Bài viết
946
Được thích
172
Giới tính
Nữ
Em có file có dữ liệu Sheet1!A2:D, 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.
Em cám ơn.
ps: click C29 của sheet!Nhap sẽ hiện Form
 

File đính kèm

  • Book1.xlsb
    26.1 KB · Đọc: 33
dùng ArrayList sort mảng 2 chiều theo tối đa 3 điều kiện, chắc còn sơ sót các bạn góp ý thêm, chạy sub main để kiểm tra
Mã:
[/QUOTE]

Quá dữ luôn!
Thật ra bạn có thể tự kiểm tra bằng cách so sánh với sort của Excel xem độ chinh xác đến đâu
 
Upvote 0
Quá dữ luôn!
Thật ra bạn có thể tự kiểm tra bằng cách so sánh với sort của Excel xem độ chinh xác đến đâu
sort theo 3 điều kiện bị sai, có khác vài trường hợp sort của Excel ở những cột không sort, có lẽ do thứ tự dò khác nhau
chỉnh lại code
Mã:
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, ColIndex1, ColIndex2, Order2, HasTitle)
        If ColIndex3 >= 1 And ColIndex3 <= UBound(Darr, 2) Then
          Darr = Arr
          Arr = SortArray2Col(Darr, ColIndex1, ColIndex2, ColIndex3, Order3, HasTitle)
        End If
      End If
    End If
    SortArray = Arr
  End If
End Function
Mã:
Function SortArray2Col(ByVal SourceArray, ByVal ColMain1 As Byte, ByVal ColMain2 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, Tmp1, Tmp2
  Darr = SourceArray
  For i = 1 - HasTitle To UBound(Darr) - 1
    If Darr(i, ColMain1) = Darr(i + 1, ColMain1) And Darr(i, ColMain2) = Darr(i + 1, ColMain2) Then
      R = i
      Tmp1 = Darr(i, ColMain1): Tmp2 = Darr(i, ColMain2)
      k = 0
      For ir = R To UBound(Darr)
        If Darr(ir, ColMain1) = Tmp1 And Darr(ir, ColMain2) = Tmp2 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
 

File đính kèm

  • Sort_Array.xlsb
    29 KB · Đọc: 17
Upvote 0
sort theo 3 điều kiện bị sai, có khác vài trường hợp sort của Excel ở những cột không sort, có lẽ do thứ tự dò khác nhau
chỉnh lại code

Bạn nên làm vài cuộc thí nghiệm để kiểm chứng. Ví dụ: Lấy dữ liệu từ bảng tính lên ListBox rồi sort gì gì đó. Xong lấy dữ liệu từ chính cái ListBox ấy để sort, sau đó nạp kết quả trở lại ListBox
Đầu tiên thử nghiệm sort 1 cột thôi nhé
Mã:
Private Sub UserForm_Initialize()
  Dim aSrc
  aSrc = Range("A2:E28").Value
  Dim aDes
  [COLOR=#ff0000]aDes = SortArray(aSrc, False, 3)[/COLOR]
  Me.ListBox1.List = aDes
End Sub 
Private Sub CommandButton1_Click()
   Dim aSrc
  aSrc = Me.ListBox1.List
  Dim aDes
  [COLOR=#ff0000]aDes = SortArray(aSrc, False, 3)[/COLOR]
  Me.ListBox1.List = aDes
End Sub
(vẽ thêm 1 CommandButton)
Để ý 2 dòng code màu đỏ là y chang nhau. Nếu kết quả nhận được khác nhau thì chứng tỏ code có vấn đề
 
Lần chỉnh sửa cuối:
Upvote 0
Bạn nên làm vài cuộc thí nghiệm để kiểm chứng. Ví dụ: Lấy dữ liệu từ bảng tính lên ListBox rồi sort gì gì đó. Xong lấy dữ liệu từ chính cái ListBox ấy để sort, sau đó nạp kết quả trở lại ListBox
Đầu tiên thử nghiệm sort 1 cột thôi nhé
Mã:
Private Sub UserForm_Initialize()
  Dim aSrc
  aSrc = Range("A2:E28").Value
  Dim aDes
  [COLOR=#ff0000]aDes = SortArray(aSrc, False, 3)[/COLOR]
  Me.ListBox1.List = aDes
End Sub 
Private Sub CommandButton1_Click()
   Dim aSrc
  aSrc = Me.ListBox1.List
  Dim aDes
  [COLOR=#ff0000]aDes = SortArray(aSrc, False, 3)[/COLOR]
  Me.ListBox1.List = aDes
End Sub
(vẽ thêm 1 CommandButton)
Để ý 2 dòng code màu đỏ là y chang nhau. Nếu kết quả nhận được khác nhau thì chứng tỏ code có vấn đề
vận hành của listbox mình không rành lắm nên không biết kiểm tra như thế nào
 
Upvote 0
vận hành của listbox mình không rành lắm nên không biết kiểm tra như thế nào

Mấy file Bạn úp mạnh thử Toàn lỗi dòng sau ko biết thiếu cái gì !!??
Mạnh Xài Office 2016 +Windows10 x32
Mã:
Set IndexList = CreateObject("System.Collections.ArrayList")
 
Upvote 0
Lần chỉnh sửa cuối:
Upvote 0
Có khi nào thiếu cái này Frame 2.0 ....Windows10 không có thì phải
Mà Hình như Anh Ndu xài Windows10 hay sao ý ...thấy xài ok mà ....--=0

Chính xác là Object này phải cài .net framework mơid xài được. Win 10 thì vào kích hoạt lên là được. Vì nó cài sẵn rồi...
 
Upvote 0
Chính xác là Object này phải cài .net framework mơid xài được. Win 10 thì vào kích hoạt lên là được. Vì nó cài sẵn rồi...

tại ông Bill thấy nó đồ cổ rồi ông keo cất kho đó mà khi nào cần thì keo nó ...giờ nó lên 4.6.1 rồi đó
 
Upvote 0
vận hành của listbox mình không rành lắm nên không biết kiểm tra như thế nào

Thì kiểm tra như code tôi ghi ở trên đó
Thật ra thì mảng lấy từ bảng tính hay lấy từ listbox cũng như như thôi
Ví dụ tôi có:
Mã:
arr1 = Range("A1:D10").Value
tôi nạp arr1 vào listbox:
Mã:
Me.ListBox1.List = arr1
Giờ tôi lại lấy dữ liệu từ listbox nạp vào 1 mảng
Mã:
arr2 = Me.ListBox1.List
Kết quả 2 mảng arr1 và arr2 là như nhau. Vậy điều gì khiến cho code sort chạy đúng khi lấy dữ liệu từ Range nhưng lại sai khi lấy từ ListBox?
Vấn đề nằm ở chỗ: Tuy 2 mảng arr1 và arr2 giống nhau nhưng có 1 điểm khác biệt "chết người", đó là mảng lấy từ Range sẽ có chuẩn BASE 1 (LBound(arr1) = 1) trong khi mảng lấy từ listbox lại có chuẩn BASE 0 (LBound(arr2) =0)
----------------------------
Điều tôi muốn nhấn mạnh ở đây là:
- Đã gọi là MẢNG BẤT KỲ thì coi như ta không biết trước được BASE = bao nhiêu (LBound(mảng) = bao nhiêu chưa biết)
- Khi viết code cho mảng, chúng ta không thể chủ quan mà xem nó như Range
- Mảng có thể lấy từ Range nhưng trong thực tế sẽ có trường hợp lấy từ nơi khác, chẳng hạn mảng do ta tự tạo ra, mảng lấy từ các control... vân vân...
- Trong 1 số trường hợp, để chuẩn hóa mảng luôn là BASE 1, người ta cho đoạn Option Base 1 lên đầu code (dưới dòng Option Explicit). Tuy nhiên điều này cũng chỉ có tác dụng với mảng do ta tự tạo ra và hoàn toàn không ăn thua gì đối với mảng được lấy từ nơi khác (có thể thí nghiệm để chứng minh)

Nói tóm lại nếu ta viết code thế này:
Mã:
For i =[SIZE=4][COLOR=#ff0000] 1[/COLOR][/SIZE] to UBound(arr,1)
 .....
Next
Thì sự chủ quan của ta nằm ở chính con số 1 (tô đỏ ở trên). Bởi làm sao ta chắc ăn 100% rằng chỉ số index đầu tiên của arr là 1 (trừ phi bạn xác định ngay từ đầu đối số của hàm phải là Range)
Chắc ăn ta luôn viết:
Mã:
For i =[SIZE=4][COLOR=#ff0000] LBound(arr,1) [/COLOR][/SIZE] to UBound(arr,1)
 .....
Next
- Mục đích viết code sort mảng 2D chủ yếu là muốn nó hoạt động ở đâu đó khác với môi trường bảng tính chứ ngay trên bảng tính Excel ta đã có công cụ sort rồi, cần gì phải viết thêm
-----------------------------------

Ôi... dài dòng quá! Không biết có ai hiểu không nữa
 
Upvote 0
Thì kiểm tra như code tôi ghi ở trên đó
Thật ra thì mảng lấy từ bảng tính hay lấy từ listbox cũng như như thôi
Ví dụ tôi có:
Mã:
arr1 = Range("A1:D10").Value
tôi nạp arr1 vào listbox:
Mã:
Me.ListBox1.List = arr1
Giờ tôi lại lấy dữ liệu từ listbox nạp vào 1 mảng
Mã:
arr2 = Me.ListBox1.List
Kết quả 2 mảng arr1 và arr2 là như nhau. Vậy điều gì khiến cho code sort chạy đúng khi lấy dữ liệu từ Range nhưng lại sai khi lấy từ ListBox?
Vấn đề nằm ở chỗ: Tuy 2 mảng arr1 và arr2 giống nhau nhưng có 1 điểm khác biệt "chết người", đó là mảng lấy từ Range sẽ có chuẩn BASE 1 (LBound(arr1) = 1) trong khi mảng lấy từ listbox lại có chuẩn BASE 0 (LBound(arr2) =0)
----------------------------
Điều tôi muốn nhấn mạnh ở đây là:
- Đã gọi là MẢNG BẤT KỲ thì coi như ta không biết trước được BASE = bao nhiêu (LBound(mảng) = bao nhiêu chưa biết)
- Khi viết code cho mảng, chúng ta không thể chủ quan mà xem nó như Range
- Mảng có thể lấy từ Range nhưng trong thực tế sẽ có trường hợp lấy từ nơi khác, chẳng hạn mảng do ta tự tạo ra, mảng lấy từ các control... vân vân...
- Trong 1 số trường hợp, để chuẩn hóa mảng luôn là BASE 1, người ta cho đoạn Option Base 1 lên đầu code (dưới dòng Option Explicit). Tuy nhiên điều này cũng chỉ có tác dụng với mảng do ta tự tạo ra và hoàn toàn không ăn thua gì đối với mảng được lấy từ nơi khác (có thể thí nghiệm để chứng minh)

Nói tóm lại nếu ta viết code thế này:
Mã:
For i =[SIZE=4][COLOR=#ff0000] 1[/COLOR][/SIZE] to UBound(arr,1)
 .....
Next
Thì sự chủ quan của ta nằm ở chính con số 1 (tô đỏ ở trên). Bởi làm sao ta chắc ăn 100% rằng chỉ số index đầu tiên của arr là 1 (trừ phi bạn xác định ngay từ đầu đối số của hàm phải là Range)
Chắc ăn ta luôn viết:
Mã:
For i =[SIZE=4][COLOR=#ff0000] LBound(arr,1) [/COLOR][/SIZE] to UBound(arr,1)
 .....
Next
- Mục đích viết code sort mảng 2D chủ yếu là muốn nó hoạt động ở đâu đó khác với môi trường bảng tính chứ ngay trên bảng tính Excel ta đã có công cụ sort rồi, cần gì phải viết thêm
-----------------------------------

Ôi... dài dòng quá! Không biết có ai hiểu không nữa
cám ơn bạn, góp ý của bạn rất hay, mình sẽ nghiên cứu và chỉnh lại các tham số code sau
ngoài ra khi nhấn command chạy list liên tục thì bị lổi, mình đã bẩy lổi nhưng không biết tại sao không được, bạn xem giúp
 

File đính kèm

  • Sort_Array1.xlsb
    32.2 KB · Đọc: 12
Upvote 0
cám ơn bạn, góp ý của bạn rất hay, mình sẽ nghiên cứu và chỉnh lại các tham số code sau

Gợi ý:
Khi bạn viết nhanh một sub, giải quyết vấn đề tại chỗ, thì bạn có thể tuỳ tiện dùng thông số mà mình đã biết trước for i = 1 to 10, hay for i = 0 to gì gì đó. Làm như vậy cho nhanh gọn. Những con số 0, 1, vv... trong lập trình gọi là magic numbers (số từ trên trời rớt xuống). Tức là những con số mà bạn biết trước sẽ luôn như vây (hằng).
Nhưng khi bạn giải quyết một vấn đề phức tạp hơn, có nhiều sub/function; và có thể bạn sẽ cóp các sub/function này lại để dùng lâu dài thì nên tránh dùng magic numbers. Nhũng con só này nếu tính được thì nên dùng hàm để tính (điển hình là LBound, UBound cho mảng); không tính được (điển hình là PI) thì bạn cho vào biến Const và đặt lên đầu module hoạc sub (tuỳ theo bạn muốn nó là toàn cục hay cục bộ). Nên nhớ là từ khoá Const được ngôn ngữ đưa ra để khai báo hằng. Ngừoi đọc code nhìn vào thì để ý ngay là code bạn có những thong số như thế.
(ngừoi đọc code có thể chính là bạn 1 vài năm sau. Néu bạn dùng nhiều magic numbers thì 1 vài năm sau, đọc lại code có thể chính bạn cũng khong hiểu)
 
Upvote 0
Gợi ý:
Khi bạn viết nhanh một sub, giải quyết vấn đề tại chỗ, thì bạn có thể tuỳ tiện dùng thông số mà mình đã biết trước for i = 1 to 10, hay for i = 0 to gì gì đó. Làm như vậy cho nhanh gọn. Những con số 0, 1, vv... trong lập trình gọi là magic numbers (số từ trên trời rớt xuống). Tức là những con số mà bạn biết trước sẽ luôn như vây (hằng).
Nhưng khi bạn giải quyết một vấn đề phức tạp hơn, có nhiều sub/function; và có thể bạn sẽ cóp các sub/function này lại để dùng lâu dài thì nên tránh dùng magic numbers. Nhũng con só này nếu tính được thì nên dùng hàm để tính (điển hình là LBound, UBound cho mảng); không tính được (điển hình là PI) thì bạn cho vào biến Const và đặt lên đầu module hoạc sub (tuỳ theo bạn muốn nó là toàn cục hay cục bộ). Nên nhớ là từ khoá Const được ngôn ngữ đưa ra để khai báo hằng. Ngừoi đọc code nhìn vào thì để ý ngay là code bạn có những thong số như thế.
(ngừoi đọc code có thể chính là bạn 1 vài năm sau. Néu bạn dùng nhiều magic numbers thì 1 vài năm sau, đọc lại code có thể chính bạn cũng khong hiểu)
cám ơn bạn, đúng như bạn góp ý, chỉnh lại các tham số quá rắc rối, nó chạy lung tung, đành phải viết lại code mới, và sau nầy muốn thêm các điều kiện sort 4, 5, 6 cũng dể
code kết hợp ArrayList và Dictionary và duyệt qua tất cả các dòng của các cột sort và thêm 1 for next lấy kết quả, nên có thể chạy chậm hơn code trước
 

File đính kèm

  • Sort_Array2.xlsb
    28 KB · Đọc: 11
Upvote 0
cám ơn bạn, góp ý của bạn rất hay, mình sẽ nghiên cứu và chỉnh lại các tham số code sau
ngoài ra khi nhấn command chạy list liên tục thì bị lổi, mình đã bẩy lổi nhưng không biết tại sao không được, bạn xem giúp

Thì bạn cũng thấy qua thí nghiệm rồi đó:
- Đầu tiên form load thì listbox có 5 cột
- Bấm CommandButton, listbox còn 4 cột
- Bấm tiếp CommandButton, listbox còn 3 cột
Và đương nhiên bấm tiếp nữa sẽ bị lỗi, bởi code button:
Mã:
Private Sub CommandButton1_Click()
   Dim aSrc
  aSrc = Me.ListBox1.List
  Test1 = UBound(aSrc, 1)
  Test2 = UBound(aSrc, 2)
  Dim aDes
  aDes = SortArray(aSrc, False, [COLOR=#ff0000]3[/COLOR])
  Me.ListBox1.List = aDes
End Sub
Sort cột 3 nhưng hiện tại có cột 3 đâu mà sort?
-----------------------------------------------------------
Vậy vấn đề nằm ở chỗ BASE 0 và BASE 1 như tôi đã đề câp ở bài 51. Cụ thể trong code của bạn:
Mã:
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)

  R = UBound(Darr) + HasTitle 'so dong du lieu Sort
  LenR = Len(CStr(R))         'so chu so cua thu tu dong
  
  [COLOR=#ff0000]For i = 1 To R[/COLOR]

End Function
Phải xem lại chỗ màu đỏ
----------------------
Để đơn giản hóa vấn đề, khuyên bạn nên làm bài toán dễ hơn, chẳng hạn lọc duy nhất từ mảng 2 chiều theo cột chỉ định, ví dụ:
Mã:
Function Unique2DArray(ByVal Source2D, ByVal ColIndex As Long)
   ........
End Function
Trong đó Source2D là mảng bất kỳ.
Nếu bạn làm được bài toán này lấy source trên range hay trên listbox đều ổn, tự nhiên bạn sẽ có ngay kinh nghiêm để làm tiếp bài toán sort2d
 
Lần chỉnh sửa cuối:
Upvote 0
Thì bạn cũng thấy qua thí nghiệm rồi đó:
- Đầu tiên form load thì listbox có 5 cột
- Bấm CommandButton, listbox còn 4 cột
- Bấm tiếp CommandButton, listbox còn 3 cột
Và đương nhiên bấm tiếp nữa sẽ bị lỗi, bởi code button:
Mã:
Private Sub CommandButton1_Click()
   Dim aSrc
  aSrc = Me.ListBox1.List
  Test1 = UBound(aSrc, 1)
  Test2 = UBound(aSrc, 2)
  Dim aDes
  aDes = SortArray(aSrc, False, [COLOR=#ff0000]3[/COLOR])
  Me.ListBox1.List = aDes
End Sub
Sort cột 3 nhưng hiện tại có cột 3 đâu mà sort?
-----------------------------------------------------------
Vậy vấn đề nằm ở chỗ BASE 0 và BASE 1 như tôi đã đề câp ở bài 51. Cụ thể trong code của bạn:
Mã:
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)

  R = UBound(Darr) + HasTitle 'so dong du lieu Sort
  LenR = Len(CStr(R))         'so chu so cua thu tu dong
  
  [COLOR=#ff0000]For i = 1 To R[/COLOR]

End Function
Phải xem lại chỗ màu đỏ
----------------------
Để đơn giản hóa vấn đề, khuyên bạn nên làm bài toán dễ hơn, chẳng hạn lọc duy nhất từ mảng 2 chiều theo cột chỉ định, ví dụ:
Mã:
Function Unique2DArray(ByVal Source2D, ByVal ColIndex As Long)
   ........
End Function
Trong đó Source2D là mảng bất kỳ.
Nếu bạn làm được bài toán này lấy source trên range hay trên listbox đều ổn, tự nhiên bạn sẽ có ngay kinh nghiêm để làm tiếp bài toán sort2d
cám ơn bạn, mình đang chỉnh lại code
bạn góp ý thêm code ở bài #54
 
Upvote 0
Bạn nên làm vài cuộc thí nghiệm để kiểm chứng. Ví dụ: Lấy dữ liệu từ bảng tính lên ListBox rồi sort gì gì đó. Xong lấy dữ liệu từ chính cái ListBox ấy để sort, sau đó nạp kết quả trở lại ListBox
Đầu tiên thử nghiệm sort 1 cột thôi nhé
Mã:
Private Sub UserForm_Initialize()
  Dim aSrc
  aSrc = Range("A2:E28").Value
  Dim aDes
  [COLOR=#ff0000]aDes = SortArray(aSrc, False, 3)[/COLOR]
  Me.ListBox1.List = aDes
End Sub 
Private Sub CommandButton1_Click()
   Dim aSrc
  aSrc = Me.ListBox1.List
  Dim aDes
  [COLOR=#ff0000]aDes = SortArray(aSrc, False, 3)[/COLOR]
  Me.ListBox1.List = aDes
End Sub
(vẽ thêm 1 CommandButton)
Để ý 2 dòng code màu đỏ là y chang nhau. Nếu kết quả nhận được khác nhau thì chứng tỏ code có vấn đề
đã chỉnh lại code chạy theo mảng hoặc range, bạn góp ý dùm
 

File đính kèm

  • Sort_Array1.xlsb
    28.4 KB · Đọc: 14
Upvote 0
đã chỉnh lại code chạy theo mảng hoặc range, bạn góp ý dùm

Vẫn chưa được bạn à:
- Đầu tiên show form, listbox có 5 cột
- Bấm Button, listbox còn 4 cột
- Càng bấm, số cột càng mất dần
Nói chung dữ liệu lấy từ range hay từ listbox thì chúng cũng có 5 cột, cớ sao qua quá trình xử lý lại bị mất đi? Có nghĩa là bạn vẫn chưa giải quyết được hoàn toàn vấn đề base 0 và base 1 của mảng
(kết quả chính xác trước rồi mới bàn tiếp về giải thuật)
 
Upvote 0
Tôi gửi bạn file dưới đây để tham khảo. Hàm sort 1 cột đơn giản thôi nhưng chắc ăn kết quả được bảo toàn
Mã:
Function Sort2DArray(ByVal Source2D, ByVal ColIndex As Long, Optional ByVal Order As Boolean = False)
  Dim aSrc, tmp
  Dim oArrList As Object
  Dim lR As Long, lC As Long, idx As Long, lPos As Long
  Dim lFstRow As Long, lEndRow As Long, lFstCol As Long, lEndCol As Long
  aSrc = Source2D
  lFstRow = LBound(aSrc, 1): lEndRow = UBound(aSrc, 1)
  lFstCol = LBound(aSrc, 2): lEndCol = UBound(aSrc, 2)
  Set oArrList = CreateObject("System.Collections.ArrayList")
  For lR = lFstRow To lEndRow
    tmp = aSrc(lR, ColIndex)
    oArrList.Add tmp
  Next
  oArrList.Sort
  If Order Then oArrList.Reverse
  ReDim aPos(oArrList.Count - 1)  'mảng chuẩn base 0
  ReDim aDes(lFstRow To lEndRow, lFstCol To lEndCol)
  For lR = lFstRow To lEndRow
    tmp = aSrc(lR, ColIndex)
    idx = oArrList.IndexOf(tmp, 0)
    lPos = idx [COLOR=#ff0000]+ lFstRow[/COLOR] + aPos(idx) ''vi tri tùy biến theo chuẩn base của mảng nguồn
    For lC = lFstCol To lEndCol
      aDes(lPos, lC) = aSrc(lR, lC)
    Next
    aPos(idx) = aPos(idx) + 1
  Next
  Sort2DArray = aDes
End Function
Không bàn về giải thuật, bạn cứ xem cách tôi xử lý base 0, base 1 thì sẽ rõ: hoàn toàn không có bất kỳ con số (0 hay 1) gì được gán vào chỉ số index đầu tiên của mảng cả (trừ phi tôi đã định trước mảng đó thuộc chuẩn nào)
 

File đính kèm

  • Sort2DArray(Using ArrayList).xlsb
    35 KB · Đọc: 47
Upvote 0
Tôi gửi bạn file dưới đây để tham khảo. Hàm sort 1 cột đơn giản thôi nhưng chắc ăn kết quả được bảo toàn
Mã:
Function Sort2DArray(ByVal Source2D, ByVal ColIndex As Long, Optional ByVal Order As Boolean = False)
  Dim aSrc, tmp
  Dim oArrList As Object
  Dim lR As Long, lC As Long, idx As Long, lPos As Long
  Dim lFstRow As Long, lEndRow As Long, lFstCol As Long, lEndCol As Long
  aSrc = Source2D
  lFstRow = LBound(aSrc, 1): lEndRow = UBound(aSrc, 1)
  lFstCol = LBound(aSrc, 2): lEndCol = UBound(aSrc, 2)
  Set oArrList = CreateObject("System.Collections.ArrayList")
  For lR = lFstRow To lEndRow
    tmp = aSrc(lR, ColIndex)
    oArrList.Add tmp
  Next
  oArrList.Sort
  If Order Then oArrList.Reverse
  ReDim aPos(oArrList.Count - 1)  'mảng chuẩn base 0
  ReDim aDes(lFstRow To lEndRow, lFstCol To lEndCol)
  For lR = lFstRow To lEndRow
    tmp = aSrc(lR, ColIndex)
    idx = oArrList.IndexOf(tmp, 0)
    lPos = idx [COLOR=#ff0000]+ lFstRow[/COLOR] + aPos(idx) ''vi tri tùy biến theo chuẩn base của mảng nguồn
    For lC = lFstCol To lEndCol
      aDes(lPos, lC) = aSrc(lR, lC)
    Next
    aPos(idx) = aPos(idx) + 1
  Next
  Sort2DArray = aDes
End Function
Không bàn về giải thuật, bạn cứ xem cách tôi xử lý base 0, base 1 thì sẽ rõ: hoàn toàn không có bất kỳ con số (0 hay 1) gì được gán vào chỉ số index đầu tiên của mảng cả (trừ phi tôi đã định trước mảng đó thuộc chuẩn nào)
code của bạn quá chuẩn, mình sẽ viết lại theo cách nầy
code viết theo kiểu đụng đâu chỉnh đó, hơi rối, đưa lên cho vui, sẽ chỉnh lại theo cách của bạn:=\+}}}}}%#^#$
 

File đính kèm

  • Sort_Array1.xlsb
    35.1 KB · Đọc: 21
Upvote 0
Web KT
Back
Top Bottom