Ứng dụng Hàm Filter với ListBox 2 cột

[viehoai]

Sau khi được giới thiệu hàm Filter tại đây http://www.giaiphapexcel.com/forum/showthread.php?32598-Xin-giới-thiệu-hàm-Filter-trong-VBA.
Tôi thử ứng dụng và gặp phải khó khăn là khi đưa vào LisBox có 2 cột, sau khi dùng hàm Filter để lọc thì đưa kết quả vào ListBox cũng dưới dạng 2 cột như ban đầu không được. Vậy xin các anh chị giúp đỡ code để hiện kết quả là 2 cột sau khi lọc (có giải thích thêm trong File)
Xin cảm ơn các anh chị

 

[ndu96081631]

Sau khi được giới thiệu hàm Filter tại đây http://www.giaiphapexcel.com/forum/showthread.php?32598-Xin-giới-thiệu-hàm-Filter-trong-VBA.
Tôi thử ứng dụng và gặp phải khó khăn là khi đưa vào LisBox có 2 cột, sau khi dùng hàm Filter để lọc thì đưa kết quả vào ListBox cũng dưới dạng 2 cột như ban đầu không được. Vậy xin các anh chị giúp đỡ code để hiện kết quả là 2 cột sau khi lọc (có giải thích thêm trong File)
Xin cảm ơn các anh chị

Thứ nhất: ListBox nhiều cột thì tương đương với mảng 2 chiều, vậy không thể dùng hàm Filter được
Thứ hai: Để Filter 1 mảng 2 chiều, bạn không nên dùng RowSource properties cho ListBox mà nên dùng List properties, vì nó có liên quan đến mảng
Việc filter mảng 2 chiều đã từng được đề cập tại đây:
http://www.giaiphapexcel.com/forum/showthread.php?47929-Sort-mảng-2-chiều
Giờ chỉ việc áp dụng vào file của bạn thế này:

Private sArray
Private Sub UserForm_Initialize()
  sArray = Sheet2.Range(Sheet2.[A2], Sheet2.[B65536].End(xlUp)).Value
  ListBox1.List() = sArray
End Sub

Private Sub TextBox1_Change()
  Dim Arr
  On Error Resume Next
  Arr = Filter2DArray(sArray, 2, TextBox1.Text)
  If Not IsArray(Arr) Then ListBox1.Clear: Exit Sub
  ListBox1.List() = IIf(Trim(TextBox1.Text) = "", sArray, Arr)
End Sub

Đương nhiên, hàm Filter đã được viết sẳn trong Module

 

[viehoai]

Thứ nhất: ListBox nhiều cột thì tương đương với mảng 2 chiều, vậy không thể dùng hàm Filter được
Thứ hai: Để Filter 1 mảng 2 chiều, bạn không nên dùng RowSource properties cho ListBox mà nên dùng List properties, vì nó có liên quan đến mảng
Việc filter mảng 2 chiều đã từng được đề cập tại đây:
http://www.giaiphapexcel.com/forum/showthread.php?47929-Sort-mảng-2-chiều
Giờ chỉ việc áp dụng vào file của bạn thế này:

Private sArray
Private Sub UserForm_Initialize()
sArray = Sheet2.Range(Sheet2.[A2], Sheet2.[B65536].End(xlUp)).Value
ListBox1.List() = sArray
End Sub

Private Sub TextBox1_Change()
Dim Arr
On Error Resume Next
Arr = Filter2DArray(sArray, 2, TextBox1.Text)
If Not IsArray(Arr) Then ListBox1.Clear: Exit Sub
ListBox1.List() = IIf(Trim(TextBox1.Text) = "", sArray, Arr)
End Sub

Đương nhiên, hàm Filter đã được viết sẳn trong Module

Cảm ơn Sư phụ rất nhiều.
Xin các anh chị và Sư phụ cho hỏi thêm: Cũng lọc như trên, em nghĩ ra thêm cách khác là dùng AutoFilter cột 2 là

 Sheet2.Range("A1:C1").AutoFilter Field:=2, Criteria1:="=*" & TextBox1.Text & "*"

Bây giờ em cần đưa kết quả đã lọc ấy vào ListBox như thế nào, em đã thữ mãi không được
Xin cảm ơn các anh chị.

 

[ndu96081631]

Cảm ơn Sư phụ rất nhiều.
Xin các anh chị và Sư phụ cho hỏi thêm: Cũng lọc như trên, em nghĩ ra thêm cách khác là dùng AutoFilter cột 2 là

 Sheet2.Range("A1:C1").AutoFilter Field:=2, Criteria1:="=*" & TextBox1.Text & "*"

Bây giờ em cần đưa kết quả đã lọc ấy vào ListBox như thế nào, em đã thữ mãi không được
Xin cảm ơn các anh chị.

Dùng cách này là dễ nhất! Sau khi AutoFilter xong thì dùng vòng lập duyệt qua các cell Visible (dùng SpecialCells(12)...) rồi Add từng em vào ListBox
Tuy nhiên phải nói rằng chỉ có cách dùng Array mới cho tốc độ nhanh nhất! Không tin bạn có thể thí nghiệm bằng code này:

Private SrcRng As Range
Private Sub UserForm_Initialize()
  Set SrcRng = Sheet2.Range(Sheet2.[A1], Sheet2.[B65536].End(xlUp))
  ListBox1.List() = Intersect(SrcRng.Offset(1), SrcRng).Value
End Sub

Private Sub TextBox1_Change()
  Dim i As Long, Clls As Range
  ListBox1.Clear
  With SrcRng
    .AutoFilter 2, "*" & TextBox1.Text & "*"
    For Each Clls In .Offset(1, 1).Resize(, 1).SpecialCells(12)
      If Clls.Value <> "" Then
        ListBox1.AddItem Clls.Offset(, -1).Value
        ListBox1.List(i, 1) = Clls.Value
        i = i + 1
      End If
    Next
    .AutoFilter
  End With
End Sub

Dữ liệu càng nhiều càng thấy rõ sự chênh lệch về tốc độ giữa 2 cách
Trước đây khi chưa hiểu lắm về Array tôi cũng dùng phương pháp AutoFilter nhưng sau này bỏ luôn rồi, chuyển toàn bộ sang xử lý mảng ---> Tốc độ tuyệt hảo!

 

[viehoai]

Thứ nhất: ListBox nhiều cột thì tương đương với mảng 2 chiều, vậy không thể dùng hàm Filter được
Thứ hai: Để Filter 1 mảng 2 chiều, bạn không nên dùng RowSource properties cho ListBox mà nên dùng List properties, vì nó có liên quan đến mảng
Việc filter mảng 2 chiều đã từng được đề cập tại đây:
http://www.giaiphapexcel.com/forum/showthread.php?47929-Sort-mảng-2-chiều
Giờ chỉ việc áp dụng vào file của bạn thế này:

Private sArray
Private Sub UserForm_Initialize()
sArray = Sheet2.Range(Sheet2.[A2], Sheet2.[B65536].End(xlUp)).Value
ListBox1.List() = sArray
End Sub

Private Sub TextBox1_Change()
Dim Arr
On Error Resume Next
Arr = Filter2DArray(sArray, 2, TextBox1.Text)
If Not IsArray(Arr) Then ListBox1.Clear: Exit Sub
ListBox1.List() = IIf(Trim(TextBox1.Text) = "", sArray, Arr)
End Sub

Đương nhiên, hàm Filter đã được viết sẳn trong Module

Xin được giúp đỡ tiếp viết lại Hàm Filter trong Module trong trường hợp TextBox1 là chuỗi bất kỳ trong nội dung công việc (dạng "*" & TextBox1 & "*")

 

[ndu96081631]

Xin được giúp đỡ tiếp viết lại Hàm Filter trong Module trong trường hợp TextBox1 là chuỗi bất kỳ trong nội dung công việc (dạng "*" & TextBox1 & "*")

Càng dễ hơn
Thay đoạn này:

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

Thành:

For i = LBound(TmpArr, 1) To UBound(TmpArr, 1)
  If InStr(UCase(TmpArr(i, ColIndex)), UCase(FindStr)) Then Dic.Add i, ""
Next

Chạy thử xem!

 

[viehoai]

Càng dễ hơn
Thay đoạn này:

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

Thành:

For i = LBound(TmpArr, 1) To UBound(TmpArr, 1)
If InStr(UCase(TmpArr(i, ColIndex)), UCase(FindStr)) Then Dic.Add i, ""
Next

Chạy thử xem!

Cảm ơn Sư phụ rất nhiều, em cứ loay hoay cả buổi mãi không được

 

[ndu96081631]

Cảm ơn Sư phụ rất nhiều, em cứ loay hoay cả buổi mãi không được

Hàm Filter2DArray này dùng đến 3 lần lập! Mục đích là để xác định chính xác kích thước của Array kết quả (để không phải dùng đến TRANSPOSE)
Tôi đang nghĩ nếu kết hợp với hàm Filter trong VBA thì có thể rút gọn code còn 2 lần lập! Khi này hàm Filter nhằm mục đích xác định LBound(TmpArr, 1) là bằng bao nhiêu. Cuối cùng chỉ cần 2 lần lập là có thể ra được kết quả
Tuy nhiên, không chắc là tốc độ có nhanh hơn cách cũ hay không? Dù sao, có thời gian rảnh bạn có thể nghiên theo giải thuật này xem
Không ngừng cải tiến là tiêu chí của người yêu thích lập trình
Ẹc... Ẹc...

 

[donasa]

file này phải nói là trên cả tuyệt vời tốc độ cực nhanh, thầy Ndu viết thêm cho em ba nút lệnh (thêm) ; (Xóa) ; (sửa) nữa đi thầy. Em cảm ơn Thầy ạ.