Sort mảng 2 chiều

Liên hệ QC

anhtuan1066

Thành viên gạo cội
Tham gia
10/3/07
Bài viết
5,802
Được thích
6,911
Đầu tiên xin mời các bạn xem qua topic này:
http://www.giaiphapexcel.com/forum/showthread.php?38005-Sắp-xếp-mảng-dữ-liệu-không-sử-dụng-vòng-lặp&
Ở đây người ta dùng JScript để sort mảng 1 chiều
Mượn tạm sự trợ giúp này, tôi xây dụng code sort mảng 2 chiều như sau:
PHP:
Function Sort1DArray(Arr, Optional isText As Boolean = False, Optional isDESC As Boolean = False)
  Dim sCommand As String
  sCommand = "('" & Join(Arr, vbBack) & "').split('" & vbBack & "').sort("
  If isText Then
    sCommand = sCommand & ")"
  Else
    sCommand = sCommand & "function(a,b){return (a-b)})"
  End If
  If isDESC Then sCommand = sCommand & ".reverse()"
  sCommand = sCommand & ".join('" & vbBack & "')"
  With CreateObject("MSScriptControl.ScriptControl")
    .Language = "JavaScript"
    Sort1DArray = Split(.Eval(sCommand), vbBack)
  End With
End Function
PHP:
Function Sort2DArray(sArray, ColIndex As Long, Order As Boolean, HasTitle As Boolean)
  Dim TmpArr, Title, i As Long, j As Long, Dic, SortArr, SortArr2
  Dim Arr, iR As Long, Tmp, Chk As Boolean
  Set Dic = CreateObject("Scripting.Dictionary")
  On Error Resume Next
  TmpArr = sArray
  'Chk = IsNumeric(TmpArr(LBound(TmpArr, 1) - HasTitle, ColIndex))
  For i = LBound(TmpArr, 1) - HasTitle To UBound(TmpArr, 1)
    Tmp = TmpArr(i, ColIndex)
    If Dic.Exists(Tmp) Then
      Tmp = Tmp & vbTab & i
      TmpArr(i, ColIndex) = Tmp
    End If
    Dic.Add Tmp, i
  Next
  Arr = TmpArr
  SortArr = Sort1DArray(Dic.Keys, Not Chk, Order)
  For i = LBound(TmpArr, 1) - HasTitle To UBound(TmpArr, 1)
    iR = Dic.Item(SortArr(i + HasTitle - 1))
    For j = LBound(sArray, 2) To UBound(sArray, 2)
      Arr(i, j) = Replace(TmpArr(iR, j), vbTab & iR, "")
    Next
  Next
  Sort2DArray = Arr
End Function
Code thử nghiệm
PHP:
Sub TestHasTitle()
  Dim sArray, Arr
  sArray = Range("A1:C10000").Value
  Arr = Sort2DArray(sArray, 2, False, True)
  Range("E1:G10000").Value = Arr
End Sub
PHP:
Sub TestNoTitle()
  Dim sArray, Arr
  sArray = Range("A2:C10000").Value
  Arr = Sort2DArray(sArray, 2, False, False)
  Range("I2:K10000").Value = Arr
End Sub
Sort dữ liệu 10000 dòng, 3 cột, kết quả gần như nháy mắt
----------------------------------------
Tạm thời vẫn chưa biết cách nào để sort được các cột chứa Number (chỉ sort dạng Text mà thôi)
Các bạn down file về thử nghiệm và cải tiến giúp những chổ còn thiếu sót nhé. Cảm ơn
 

File đính kèm

  • Sort_2D_Array_01.rar
    123.9 KB · Đọc: 524
Code này cần phải cải tiến lại, có lẽ xác định chỉ số dòng iR như code trên là chưa chính xác! Ngoài ra, cải tiến thêm cho phép sort number
PHP:
Function Sort2DArray(sArray, ColIndex As Long, Order As Boolean, HasTitle As Boolean)
  Dim TmpArr, i As Long, j As Long, Dic, SortArr
  Dim Arr, iR As Long, Tmp, Chk As Boolean
  Set Dic = CreateObject("Scripting.Dictionary")
  'On Error Resume Next
  TmpArr = sArray
  ColIndex = ColIndex + LBound(TmpArr, 2) - 1
  Chk = IsNumeric(TmpArr(LBound(TmpArr, 1) - HasTitle, ColIndex))
  For i = LBound(TmpArr, 1) - HasTitle To UBound(TmpArr, 1)
    Tmp = TmpArr(i, ColIndex)
    If Dic.Exists(Tmp) Then
      If Chk Then
        Tmp = Tmp + i / (10 ^ 10)
      Else
        Tmp = Tmp & vbTab & i
      End If
      TmpArr(i, ColIndex) = Tmp
    End If
    Dic.Add Tmp, i
  Next
  Arr = TmpArr
  SortArr = Sort1DArray(Dic.Keys, Not Chk, Order)
  For i = LBound(SortArr, 1) To UBound(SortArr, 1)
    If Chk Then
      iR = Dic.Item(CDbl(SortArr(i)))
    Else
      iR = Dic.Item(CStr(SortArr(i)))
    End If
    For j = LBound(TmpArr, 2) To UBound(TmpArr, 2)
      If Chk Then
        If j = ColIndex Then
          Arr(i + LBound(TmpArr, 1) - HasTitle, j) = TmpArr(iR, j) - iR / (10 ^ 10)
        Else
          Arr(i + LBound(TmpArr, 1) - HasTitle, j) = TmpArr(iR, j)
        End If
      Else
        Arr(i + LBound(TmpArr, 1) - HasTitle, j) = Replace(TmpArr(iR, j), vbTab & iR, "")
      End If
    Next
  Next
  Sort2DArray = Arr
End Function
Yêu cầu: Cột cần sort hoặc thuộc dạng Number, hoặc thuộc dạng Text (không lộn xộn 2 kiểu dữ liệu)
Rắc rối của code này là mảng Base 0 lộn xộn với mảng Base 1, phải làm sao để có thể áp dụng được trên Range hoặc trên mảng bất kỳ (chẳng hạn là List của ListBox)
Các bạn vui lòng kiểm tra độ chính xác giúp tôi (vẫn cảm giác có gì đó chưa ổn). Cảm ơn!
 

File đính kèm

  • Sort_2D_Array_02.rar
    140.4 KB · Đọc: 267
Lần chỉnh sửa cuối:
Upvote 0
Tạo ứng dụng

Trước đây tôi có làm 1 form hổ trợ tìm kiếm và nhập liệu. Việc tìm kiếm thì dùng AutoFilter, còn sort dữ liệu trên ListBox thì đương nhiên dùng chức năng Sort sẳn có của Excel để làm: Sort trên bảng tính, xong gán dữ liệu từ bảng tính vào ListBox
Cảm thấy cách làm đó tuy đơn giản nhưng không mấy chuyên nghiệp, vả lại tốc độ xử lý cũng không cao!
Như ta đã biết, việc Filter đối với mảng 1 chiều thì đã có hàm Filter giải quyết. Vậy hôm nay tôi viết thêm hàm Filter2DArray nữa là có thể đưa vào ứng dụng với form hổ trợ tìm kiếm và nhập liệu rồi
Hàm Filter2DArray như sau:
PHP:
Function Filter2DArray(sArray, ColIndex As Long, FindStr As String)
  Dim TmpArr, i As Long, j As Long, Arr, Dic, TmpStr, Tmp
  Set Dic = CreateObject("Scripting.Dictionary")
  TmpArr = sArray
  ColIndex = ColIndex + LBound(TmpArr, 2) - 1
  For i = LBound(TmpArr, 1) To UBound(TmpArr, 1)
    TmpStr = Left(TmpArr(i, ColIndex), Len(FindStr))
    If UCase(TmpStr) = UCase(FindStr) Then Dic.Add i, ""
  Next
  If Dic.Count > 0 Then
    Tmp = Dic.Keys
    ReDim Arr(UBound(Tmp), LBound(TmpArr, 2) To UBound(TmpArr, 2))
    For i = LBound(Tmp) To UBound(Tmp)
      For j = LBound(TmpArr, 2) To UBound(TmpArr, 2)
        Arr(i, j) = TmpArr(Tmp(i), j)
      Next
    Next
  End If
  Filter2DArray = Arr
End Function
Vẫn sử dụng sự trợ giúp của Dictionary Object để định vị chỉ số dòng cần lấy ra kết quả
Giao diện Form như sau:

untitled.JPG

Với form này thì:
- Khi bấm vào các tiêu đề của ListBox thì dữ liệu sẽ được sort đúng tại cột này
- Gõ vài ký tự gợi nhớ vào TextBox thì List sẽ được thu gọn lại đúng với từ khóa tìm kiếm trên cột mà trước đó ta đã bấm (tức có thể tìm kiếm trên từng cột)
- Double Click vào 1 dòng nào đó trên ListBox, đồng nghĩa sẽ gán dữ liệu xuống bảng tính
-------------------------------------------
Vẫn là câu nói cũ: Cái khó ở đây là phải tính toán trên Array bất kể nó là Base 0 hay Base 1. Tức có thể làm việc với Range trên bảng tính (dùng Base 1) cũng như các mảng khác như ListBox chẳng hạn (dùng Base 0)
Xin các bạn vui lòng tải file về test giúp và góp ý để hoàn thiện hơn
Cảm ơn
ANH TUẤN
 

File đính kèm

  • mc_request_05.rar
    32.6 KB · Đọc: 343
Upvote 0
Với form này thì:
- Gõ vài ký tự gợi nhớ vào TextBox thì List sẽ được thu gọn lại đúng với từ khóa tìm kiếm trên cột mà trước đó ta đã bấm (tức có thể tìm kiếm trên từng cột)
ANH TUẤN
---
Anh đọc code bài củ thì hiểu, hiện đang ứng dụng rất nhiều trong công việc, rất cám ơn chú. Riêng code bài này thì xin thua +-+-+-+, chú có thể làm thêm phần nút chọn tìm kiếm theo cột cho tiện xử dụng hơn là tìm kiếm trên cột mà trước đó ta đã bấm. Trân trọng
 
Upvote 0
---
Anh đọc code bài củ thì hiểu, hiện đang ứng dụng rất nhiều trong công việc, rất cám ơn chú. Riêng code bài này thì xin thua +-+-+-+, chú có thể làm thêm phần nút chọn tìm kiếm theo cột cho tiện xử dụng hơn là tìm kiếm trên cột mà trước đó ta đã bấm. Trân trọng
Thì anh muốn tìm cột nào, anh chỉ việc bấm vào tiêu đề cột đó rồi hẳn gõ vào TextBox là được rồi
Code này làm việc hoàn toàn trên Array, không đụng tí nào ở bảng tính cả nên anh sẽ chẳng thấy nó "giựt giựt" như trước đâu (tốc độ nhanh hơn)
 
Upvote 0
Nhân đây xin đố các bạn 1 vấn đề!
Trong file mc_mc_request_05 ở bài #3 có đoạn code sau:
Mã:
Private Sub CommandButton3_Click()
  Dim Arr
  SortOrder = Not SortOrder
  Arr = Sort2DArray(ListBox1.List, 1, SortOrder, False)
  ListBox1.List() = Arr
  ListBox1.Selected(0) = True
  CommandButton3.BackColor = 16711680
  CommandButton4.BackColor = 16744576
  CommandButton5.BackColor = 16744576
  [COLOR=red][B]Col = 1[/B][/COLOR]
End Sub
Mã:
Private Sub CommandButton4_Click()
  Dim Arr
  SortOrder = Not SortOrder
  Arr = Sort2DArray(ListBox1.List, 2, SortOrder, False)
  ListBox1.List() = Arr
  ListBox1.Selected(0) = True
  CommandButton3.BackColor = 16744576
  CommandButton4.BackColor = 16711680
  CommandButton5.BackColor = 16744576
  [COLOR=red][B]Col = 2[/B][/COLOR]
End Sub
Mã:
Private Sub CommandButton5_Click()
  Dim Arr
  SortOrder = Not SortOrder
  Arr = Sort2DArray(ListBox1.List, 3, SortOrder, False)
  ListBox1.List() = Arr
  ListBox1.Selected(0) = True
  CommandButton3.BackColor = 16744576
  CommandButton4.BackColor = 16744576
  CommandButton5.BackColor = 16711680
  [COLOR=red][B]Col = 3[/B][/COLOR]
End Sub
Giá trị Col được đặt ở cuối code. Nếu bây giờ ta đưa Col lên đầu code thì khởi động Form, gõ text vào Texbox sẽ cho kết quả không chính xác
Xin hỏi: Tại sao lại như vậy?
Ẹc... Ẹc...
 
Upvote 0
Nhân đây xin đố các bạn 1 vấn đề!
Trong file mc_mc_request_05 ở bài #3 có đoạn code sau:
Mã:
Private Sub CommandButton3_Click()
  Dim Arr
  SortOrder = Not SortOrder
  Arr = Sort2DArray(ListBox1.List, 1, SortOrder, False)
  ListBox1.List() = Arr
  ListBox1.Selected(0) = True
  CommandButton3.BackColor = 16711680
  CommandButton4.BackColor = 16744576
  CommandButton5.BackColor = 16744576
  [COLOR=red][B]Col = 1[/B][/COLOR]
End Sub
Mã:
Private Sub CommandButton4_Click()
  Dim Arr
  SortOrder = Not SortOrder
  Arr = Sort2DArray(ListBox1.List, 2, SortOrder, False)
  ListBox1.List() = Arr
  ListBox1.Selected(0) = True
  CommandButton3.BackColor = 16744576
  CommandButton4.BackColor = 16711680
  CommandButton5.BackColor = 16744576
  [COLOR=red][B]Col = 2[/B][/COLOR]
End Sub
Mã:
Private Sub CommandButton5_Click()
  Dim Arr
  SortOrder = Not SortOrder
  Arr = Sort2DArray(ListBox1.List, 3, SortOrder, False)
  ListBox1.List() = Arr
  ListBox1.Selected(0) = True
  CommandButton3.BackColor = 16744576
  CommandButton4.BackColor = 16744576
  CommandButton5.BackColor = 16711680
  [COLOR=red][B]Col = 3[/B][/COLOR]
End Sub
Giá trị Col được đặt ở cuối code. Nếu bây giờ ta đưa Col lên đầu code thì khởi động Form, gõ text vào Texbox sẽ cho kết quả không chính xác
Xin hỏi: Tại sao lại như vậy?
Ẹc... Ẹc...
Sao tôi đưa dòng đó lên đầu code nhưng nó vẫn chạy đúng nhỉ?
Nhân đây tôi cũng xin hỏi thêm: Hàm Filter chỉ lọc với điều kiện Begins with... (Các ký tự đầu giống với chuỗi cần tìm thì lọc ra). Vậy có cách nào lọc theo kiểu Contains hoặc là Ends with,... hay không (không dùng vòng lặp)
 
Upvote 0
Sao tôi đưa dòng đó lên đầu code nhưng nó vẫn chạy đúng nhỉ?
Nhân đây tôi cũng xin hỏi thêm: Hàm Filter chỉ lọc với điều kiện Begins with... (Các ký tự đầu giống với chuỗi cần tìm thì lọc ra). Vậy có cách nào lọc theo kiểu Contains hoặc là Ends with,... hay không (không dùng vòng lặp)
Sửa code thành vầy xem nha:
Mã:
Private Sub CommandButton3_Click()
  Dim Arr
  [COLOR=red][B]Col [/B][/COLOR]= 1
  SortOrder = Not SortOrder
  Arr = Sort2DArray(ListBox1.List, [COLOR=red][B]Col[/B][/COLOR], SortOrder, False)
  ListBox1.List() = Arr
  ListBox1.Selected(0) = True
  CommandButton3.BackColor = 16711680
  CommandButton4.BackColor = 16744576
  CommandButton5.BackColor = 16744576
End Sub
Mã:
Private Sub CommandButton4_Click()
  Dim Arr
  [COLOR=red][B]Col[/B][/COLOR] = 2
  SortOrder = Not SortOrder
  Arr = Sort2DArray(ListBox1.List, [COLOR=red][B]Col[/B][/COLOR], SortOrder, False)
  ListBox1.List() = Arr
  ListBox1.Selected(0) = True
  CommandButton3.BackColor = 16744576
  CommandButton4.BackColor = 16711680
  CommandButton5.BackColor = 16744576
End Sub
Mã:
Private Sub CommandButton5_Click()
  Dim Arr
  [COLOR=red][B]Col [/B][/COLOR] = 3
  SortOrder = Not SortOrder
  Arr = Sort2DArray(ListBox1.List, [COLOR=red][B]Col[/B][/COLOR], SortOrder, False)
  ListBox1.List() = Arr
  ListBox1.Selected(0) = True
  CommandButton3.BackColor = 16744576
  CommandButton4.BackColor = 16744576
  CommandButton5.BackColor = 16711680
End Sub
Đây là bằng chứng

untitled.JPG

------------------------------
Ah... bạn đang nói đến hàm Filter nào thế? Hàm Filter có sẳn trong VBA chăng?
 
Lần chỉnh sửa cuối:
Upvote 0
Sửa code thành vầy xem nha:
Mã:
Private Sub CommandButton3_Click()
  Dim Arr
  [COLOR=red][B]Col [/B][/COLOR]= 1
  SortOrder = Not SortOrder
  Arr = Sort2DArray(ListBox1.List, [COLOR=red][B]Col[/B][/COLOR], SortOrder, False)
  ListBox1.List() = Arr
  ListBox1.Selected(0) = True
  CommandButton3.BackColor = 16711680
  CommandButton4.BackColor = 16744576
  CommandButton5.BackColor = 16744576
End Sub
Mã:
Private Sub CommandButton4_Click()
  Dim Arr
  [COLOR=red][B]Col[/B][/COLOR] = 2
  SortOrder = Not SortOrder
  Arr = Sort2DArray(ListBox1.List, [COLOR=red][B]Col[/B][/COLOR], SortOrder, False)
  ListBox1.List() = Arr
  ListBox1.Selected(0) = True
  CommandButton3.BackColor = 16744576
  CommandButton4.BackColor = 16711680
  CommandButton5.BackColor = 16744576
End Sub
Mã:
Private Sub CommandButton5_Click()
  Dim Arr
  [COLOR=red][B]Col [/B][/COLOR] = 3
  SortOrder = Not SortOrder
  Arr = Sort2DArray(ListBox1.List, [COLOR=red][B]Col[/B][/COLOR], SortOrder, False)
  ListBox1.List() = Arr
  ListBox1.Selected(0) = True
  CommandButton3.BackColor = 16744576
  CommandButton4.BackColor = 16744576
  CommandButton5.BackColor = 16711680
End Sub
Đây là bằng chứng

View attachment 61736

------------------------------
Ah... bạn đang nói đến hàm Filter nào thế? Hàm Filter có sẳn trong VBA chăng?
Nếu sửa lại như thế thì khi gọi hàm Sort2DArray biến Col đã bị thay đổi do trong hàm Sort2DArray bạn thay đổi giá trị của biến ColIndex. Do biến Col thay đổi nên khi gọi hàm Filter2DArray ở sự kiện TextBox1_Change() kết quả không còn như mong muốn.

Đúng là tôi đang đề cập đến hàm Filter sẵn có trong VBA.
 
Upvote 0
Nếu sửa lại như thế thì khi gọi hàm Sort2DArray biến Col đã bị thay đổi do trong hàm Sort2DArray bạn thay đổi giá trị của biến ColIndex. Do biến Col thay đổi nên khi gọi hàm Filter2DArray ở sự kiện TextBox1_Change() kết quả không còn như mong muốn.
.
Đúng lý ra sẽ không có chuyện gì xảy ra cả vì tôi đã cố tình đặt biến Col khác tên với ColIndex rồi
Và xin hỏi cách khắc phục TRIỆT ĐỂ sẽ như thế nào? Nên hiểu TRIỆT ĐỂ ở đây là tôi có thể đặt biến chổ nào cũng được cả (đây cũng chỉ là vấn đề cơ bản khi viết code nhưng mọi người ít khi chú ý mà thôi)
Đúng là tôi đang đề cập đến hàm Filter sẵn có trong VBA.
Tôi thấy nó tìm theo nội dung mà bạn, bất kể chuổi tìm nằm đầu hay giữa hay cuối gì nó cũng tìm được (miễn sao là tìm thấy)
Xem ở đây:
http://www.giaiphapexcel.com/forum/showthread.php?32598-Xin-gi%E1%BB%9Bi-thi%E1%BB%87u-h%C3%A0m-Filter-trong-VBA.
 
Upvote 0
Đúng lý ra sẽ không có chuyện gì xảy ra cả vì tôi đã cố tình đặt biến Col khác tên với ColIndex rồi
Và xin hỏi cách khắc phục TRIỆT ĐỂ sẽ như thế nào? Nên hiểu TRIỆT ĐỂ ở đây là tôi có thể đặt biến chổ nào cũng được cả (đây cũng chỉ là vấn đề cơ bản khi viết code nhưng mọi người ít khi chú ý mà thôi)

Tôi thấy nó tìm theo nội dung mà bạn, bất kể chuổi tìm nằm đầu hay giữa hay cuối gì nó cũng tìm được (miễn sao là tìm thấy)
Xem ở đây:
http://www.giaiphapexcel.com/forum/showthread.php?32598-Xin-giới-thiệu-hàm-Filter-trong-VBA.
Có lẽ khai báo ByVal cho biến ColIndex trong Function là được.
Thông thường thì đúng là đặt biến khác thì sẽ không có chuyện gì. Vậy Bác có biết lý do tại sao không?
Sao lúc trước mình test lại thấy nó chỉ lọc với chuỗi tìm nằm ở đầu thôi. Bây giờ thì lại được. Lâu nay cứ thắc mắc mãi +-+-+-+
 
Upvote 0
Có lẽ khai báo ByVal cho biến ColIndex trong Function là được.
Thông thường thì đúng là đặt biến khác thì sẽ không có chuyện gì. Vậy Bác có biết lý do tại sao không?
Hoàn toàn chính xác về cái vụ ByValByRef này rồi
Hàm ta viết vầy:
PHP:
Function Filter2DArray(sArray, ColIndex As Long, FindStr As String)
Chẳng nói gì đến vụ ByVal hay ByRef thì mặc định nó xem như là ByRef
Phải sửa lại thành vầy mới là ổn:
PHP:
Function Filter2DArray(byVal sArray, byVal ColIndex As Long, byVal FindStr As String)
Cái này đã từng để cập ở đây:
http://www.giaiphapexcel.com/forum/showthread.php?35509-Th%E1%BA%A3o-lu%E1%BA%ADn-m%E1%BB%9F-r%E1%BB%99ng-v%E1%BB%81-Useful-functions-C%C3%A1c-h%C3%A0m-h%E1%BB%AFu-%C3%ADch-c%E1%BB%A7a-L%C3%AA-V%C4%83n-Duy%E1%BB%87t&p=235377#post235377
Nhưng thật sự chưa "bị dính chưởng" thì chưa ngộ ra được vấn đề
(mà bạn huuthang_bd nhanh tay quá, phải đợi cho mọi người nghiên cứu chứ.. Ẹc.. Ẹc...)
-------------------------------------
Sao lúc trước mình test lại thấy nó chỉ lọc với chuỗi tìm nằm ở đầu thôi. Bây giờ thì lại được. Lâu nay cứ thắc mắc mãi
Lý ra tôi đã dùng hàm Filter để giải quyết bài này, nhưng cũng vì nó không tìm từ trái sang phải (như từ điển) nên đành phải tự viết lấy
 
Lần chỉnh sửa cuối:
Upvote 0
Tiếp tục cải tiến!

Hôm nay tôi lại tiếp tục cải tiến để hoàn thiện thuật toán Sort mảng 2 chiều
- Hàm Sort2DArray ở các bài trước dùng vòng lập duyệt qua cột cần sort rồi add vào Dictionary, nếu có dữ liệu trùng sẽ ghép thêm 1 chuổi tạm (đối với dữ liệu dạng Text) hoặc cộng thêm 1 gia số (đối với dữ liệu dạng Number)
- Với dữ liệu dạng Text thì chẳng nói làm gì nhưng còn với dạng Number thì việc cộng thêm 1 gia số là khá nguy hiểm! Ta thừa biết 1 giá trị A sau khi cộng thêm gia số X rồi trừ đi chính gia số X này cũng chưa chắc trả về kết quả là A. Cách tính toán của Excel luôn có những sai số không lường trước
- Hàm Sort2DArray cải tiến mới này sẽ không đụng chạm gì đến dữ liệu gốc, chỉ đơn giản là đánh dấu vị trí rồi gán vào mảng mới tại 1 ví trí phù hợp
PHP:
Function Sort2DArray(ByVal sArray, ByVal ColIndex As Long, ByVal Order As Boolean, ByVal HasTitle As Boolean)
  Dim TmpArr, i As Long, j As Long, Dic, SortArr, Item1, Item2
  Dim Arr, iR As Long, Tmp, Chk As Boolean
  Set Dic = CreateObject("Scripting.Dictionary")
  On Error Resume Next
  TmpArr = sArray: Arr = TmpArr
  ColIndex = ColIndex + LBound(TmpArr, 2) - 1
  Chk = IsNumeric(TmpArr(LBound(TmpArr, 1) - HasTitle, ColIndex))
  ReDim Tmp(LBound(TmpArr, 1) - HasTitle To UBound(TmpArr, 1))
  For i = LBound(TmpArr, 1) - HasTitle To UBound(TmpArr, 1)
    Tmp(i) = TmpArr(i, ColIndex)
  Next
  SortArr = Sort1DArray(Tmp, Not Chk, Order)
  With CreateObject("Scripting.Dictionary")
    For i = LBound(SortArr) To UBound(SortArr)
      If Not .Exists(CStr(SortArr(i))) Then .Add CStr(SortArr(i)), i
    Next
    For i = LBound(TmpArr, 1) - HasTitle To UBound(TmpArr, 1)
      iR = .Item(CStr(TmpArr(i, ColIndex)))
      .Item(CStr(TmpArr(i, ColIndex))) = iR + 1
      For j = LBound(TmpArr, 2) To UBound(TmpArr, 2)
        Arr(iR, j) = TmpArr(i, j)
      Next
    Next
  End With
  Sort2DArray = Arr
End Function
-------------------------------------------------------------
Nhân tiện đọc bài viết của bạn viethoai tại đây:
http://www.giaiphapexcel.com/forum/showthread.php?48402-Ứng-dụng-Hàm-Filter-với-ListBox-2-cột
Tôi nghĩ rằng người dùng khi filter dữ liệu thường có 3 nhu cầu: Tìm kiếm theo kiểu Begins with, containsEnds with! Vậy ta cải tiến lại hàm Filter2DArray theo hướng tổng quát để người dùng tùy ý chọn 1 Custom Filter (giống như AutoFilter).
Tôi nhận thấy toán tử Like có thể làm được điều này:
PHP:
Function Filter2DArray(ByVal sArray, ByVal ColIndex As Long, ByVal FindStr As String)
  Dim TmpArr, i As Long, j As Long, Arr, Dic, TmpStr, Tmp
  Set Dic = CreateObject("Scripting.Dictionary")
  TmpArr = sArray
  ColIndex = ColIndex + LBound(TmpArr, 2) - 1
  For i = LBound(TmpArr, 1) To UBound(TmpArr, 1)
    If UCase(TmpArr(i, ColIndex)) Like UCase(FindStr) Then Dic.Add i, ""
  Next
  If Dic.Count > 0 Then
    Tmp = Dic.Keys
    ReDim Arr(UBound(Tmp), LBound(TmpArr, 2) To UBound(TmpArr, 2))
    For i = LBound(Tmp) To UBound(Tmp)
      For j = LBound(TmpArr, 2) To UBound(TmpArr, 2)
        Arr(i, j) = TmpArr(Tmp(i), j)
      Next
    Next
  End If
  Filter2DArray = Arr
End Function
Áp dụng:
Arr = Filter2DArray(sArray, ColIndex, FindStr & "*" ---> Sẽ tìm theo kiểu Begins with
Arr = Filter2DArray(sArray, ColIndex, "*" & FindStr & "*" ---> Sẽ tìm theo kiểu Contains
Arr = Filter2DArray(sArray, ColIndex, "*" & FindStr ---> Sẽ tìm theo kiểu Ends with
Xem file mới này và kiểm tra độ chính xác nhé
 

File đính kèm

  • FilterAndSort_2DArray_02.rar
    37.7 KB · Đọc: 277
Lần chỉnh sửa cuối:
Upvote 0
Sort mảng 2 chiều viết rồi mà (cái này thì tôi nhớ chắc vì xài hoài)
Nó ở đây:
http://www.giaiphapexcel.com/forum/showthread.php?47929-Sort-mảng-2-chiều
Tìm mấy bài cuối ấy!
Tuy nhiên, theo nhận xét của tôi thì vụ sort xiết này rất khó nhai ---> Phải cải tiến thêm nữa mới xong!
(phải có người rảnh rỗi thí nghiệm để tìm cái sai rồi mới biết phải cần cải tiến thứ gì)

Đúng là cần phải cải tiến thêm rồi Thầy ơi, vì các lý do sau:

1) Kết quả xuất ra mất một Item, ngược lại double 1 đến 2 mục!

2) Theo em nghĩ, đã là mảng 2 chiều thì bao hàm luôn mảng 1 chiều, vì thế nên cải tiến ghép chúng lại thành một.

Xin vui lòng xem File để dễ dàng nhận thấy và so sánh.

PHP:
Private Sub CommandButton1_Click()
        Dim MyArray
        [D3:E50].ClearContents
        ''Sort tu A den Z CÓ tieu de:
        MyArray = Sort2DArray(Range([B2], [B65536].End(xlUp)), 1, False, True)
        [D3].Resize(UBound(MyArray)) = MyArray
        ''Sort tu A den Z KHÔNG tieu de:
        MyArray = Sort2DArray(Range([B3], [B65536].End(xlUp)), 1, False, False)
        [E3].Resize(UBound(MyArray)) = MyArray
End Sub
''==================================================================================================================

Private Sub CommandButton2_Click()
        Dim MyArray
        [G3:H20].ClearContents
        ''Sort tu Z den A CÓ tieu de:
        MyArray = Sort2DArray(Range([B2], [B65536].End(xlUp)), 1, True, True)
        [G3].Resize(UBound(MyArray)) = MyArray
        ''Sort tu Z den A KHÔNG tieu de:
        MyArray = Sort2DArray(Range([B3], [B65536].End(xlUp)), 1, True, False)
        [H3].Resize(UBound(MyArray)) = MyArray
End Sub
 

File đính kèm

  • Sort2DArray.xls
    53.5 KB · Đọc: 79
Upvote 0
Đúng là cần phải cải tiến thêm rồi Thầy ơi, vì các lý do sau:

1) Kết quả xuất ra mất một Item, ngược lại double 1 đến 2 mục!

2) Theo em nghĩ, đã là mảng 2 chiều thì bao hàm luôn mảng 1 chiều, vì thế nên cải tiến ghép chúng lại thành một.

Xin vui lòng xem File để dễ dàng nhận thấy và so sánh.
Hàm này chỉ sort mảng chứa dữ liệu hoặc là Number hoặc là Text thôi ---> Lộn xộn 2 loại dữ liệu, tôi chưa đủ sức làm nổi đâu
Ngoài ra hàm còn 1 tí xíu trục trặc cần cải tiến... để từ từ tôi nghiên cứu xem (có thể sẽ là 1 giải thuật hoàn toàn khác)
(Mấy trò này rất trừu tượng... phải tưởng tưởng đến vỡ đầu mới mong nghĩ ra được)
 
Upvote 0
Hàm này chỉ sort mảng chứa dữ liệu hoặc là Number hoặc là Text thôi ---> Lộn xộn 2 loại dữ liệu, tôi chưa đủ sức làm nổi đâu
Ngoài ra hàm còn 1 tí xíu trục trặc cần cải tiến... để từ từ tôi nghiên cứu xem (có thể sẽ là 1 giải thuật hoàn toàn khác)
(Mấy trò này rất trừu tượng... phải tưởng tưởng đến vỡ đầu mới mong nghĩ ra được)

Nếu dữ liệu hoặc là chữ, hoặc là số vẫn bị mất 1 mục và đúp nhiều mục. Thầy thử sẽ thấy ạ!

Nếu mà được bộ 3 Sort2DArray, Filter2DArray & Unique2DArray hoàn chỉnh thì việc xử lý dữ liệu không những không khó khăn mà còn cải thiện tốc độ đáng kể vì không phải thực hiện trên sheet nữa.
 
Lần chỉnh sửa cuối:
Upvote 0
Nếu dữ liệu hoặc là chữ, hoặc là số vẫn bị mất 1 mục và đúp nhiều mục. Thầy thử sẽ thấy ạ!

Nếu mà được bộ 3 Sort2DArray, Filter2DArray & Unique2DArray hoàn chỉnh thì việc xử lý dữ liệu không những không khó khăn mà còn cải thiện tốc độ đáng kể vì không phải thực hiện trên sheet nữa.
Tôi đang trong quá trình nghiên cứu... Riêng phần Sort tôi đang hướng tới việc sort chuổi tiếng Việt Unicode ---> Cái này có đầy rồi nhưng tôi muốn làm khác hơn: Tất cả thực thi tính toán trên Array, đương nhiên tốc độ tính toán sẽ cực nhanh (có điều độ khó cũng tăng thêm)
 
Upvote 0
Tôi đang trong quá trình nghiên cứu... Riêng phần Sort tôi đang hướng tới việc sort chuổi tiếng Việt Unicode ---> Cái này có đầy rồi nhưng tôi muốn làm khác hơn: Tất cả thực thi tính toán trên Array, đương nhiên tốc độ tính toán sẽ cực nhanh (có điều độ khó cũng tăng thêm)

Xin Bravo, thật khốn khổ với việc Sort tiếng Việt. Hy vọng sớm có võ mới.....Cố lên NDU!!!!
 
Upvote 0
Xin Bravo, thật khốn khổ với việc Sort tiếng Việt. Hy vọng sớm có võ mới.....Cố lên NDU!!!!

Ý đồ cùa em thế này:
- Tạo trước 1 mảng bao gồm tất cả các ký tự, kể cả ký tự đặc biết, ký tự số, ký tự tiếng Việt có dấu
- Mảng này được sort trước từ nhỏ đến lớn (tự ta sắp xếp bằng tay trước)
- Tách từ ký tự trong chuổi rồi so với mảng xem ký tự vừa tách ra nằm ở Index mấy
- vân vân...
.........................
Đại khái là thế nhưng còn cả đống quy trình tính toán sau đó nữa
Để hôm nào đầu óc thật thanh thản, em sẽ bắt tay "mần" vụ này... Tuy nhiên, nếu có thể được, xin anh em giúp sức với em với (Quá khó, vì dù đã có giải thuật cũng chưa chắc thực hiện được)
 
Upvote 0
Mình cũng từng định làm vấn đề này nhưng bận mải rồi bỏ bê. Mình nêu sơ bộ dự kiến phương án của mình nha:
1/Tạo mảng có n cột: Cột 1 đến n-1 là dữ liệu gốc
2/Côt n chứa kết quả dùng code có nhiệm vụ dưới chuyển data từ cột cần sort
-Chia x ký tự trong cột sort thành x*2 phần tử. Mỗi ký tự có 2 phần tử 1 ký tự: ký tự không dấu và phần tử chứa thứ tự dấu tiếng Việt.
Sau đó ta ghép tất thành chuỗi x*2 ký tự .
3/Sort lại mảng dựa trên data cột n theo nguyên tắc so sánh bình thường
4/Đưa kết quả về vị trí cần thiết

Chưa làm nên chũng chưa biết có gì vướng mắc đằng sau nó không?
 
Upvote 0
Web KT

Bài viết mới nhất

Back
Top Bottom