Giúp code lọc dữ liệu trong Listbox (2 người xem)

[congnguyen88]

Mình tìm đoạn code này tại trang: http://www.giaiphapexcel.com/forum/s...h%C3%B4ng-minh

tác giả Của bạn : quang hà

Code này khá là hay, chỉ cần đánh 1 số từ liên quan trong textbox thì Listbox sẽ hiện ra danh sách những từ liên quan. tất cả đều ok

Nhưng khổ nỗi chỉ lọc được tên hàng khoảng dưới 100 tên hàng, còn lớn hơn thì lọc không được và rất chậm. Mấy bạn tải file mình xuống thử gõ vào xem không thể nào lọc với số lượng tên hàng lớn, Anh em nào có giải pháp nào không giúp mình với. Xin cảm ơn

 

[Hoàng Trọng Nghĩa]

Bạn thử thay code loc của bạn bằng code này xem sao:

Sub loc()
    Static ArrData
    Dim ArrFilter()
    Dim r As Long, n As Long
    If Not IsArray(ArrData) Then
        r = Sheets("tenhang").Range("A" & Rows.Count).End(xlUp).Row
        ArrData = Sheets("tenhang").Range("A2:A" & r)
    End If
    With Sheets("Sheet1")
        For r = 1 To UBound(ArrData)
            If LCase(TV(ArrData(r, 1))) Like "*" & LCase(TV(.TextBox1)) & "*" Then
                n = n + 1
                ReDim Preserve ArrFilter(1 To n)
                ArrFilter(n) = ArrData(r, 1)
            End If
        Next
        If n Then
            .ListBox1.List = ArrFilter
        Else
            .ListBox1.List = Array()
        End If
    End With
End Sub

Đồng thời, thay vì bạn dùng sự kiện Change thì bạn xóa đi, và dùng sự kiện KeyUp xem sao!

Private Sub TextBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    loc
End Sub

 

[congnguyen88]

Bạn thử thay code loc của bạn bằng code này xem sao:

Sub loc()
    Static ArrData
    Dim ArrFilter()
    Dim r As Long, n As Long
    If Not IsArray(ArrData) Then
        r = Sheets("tenhang").Range("A" & Rows.Count).End(xlUp).Row
        ArrData = Sheets("tenhang").Range("A2:A" & r)
    End If
    With Sheets("Sheet1")
        For r = 1 To UBound(ArrData)
            If LCase(TV(ArrData(r, 1))) Like "*" & LCase(TV(.TextBox1)) & "*" Then
                n = n + 1
                ReDim Preserve ArrFilter(1 To n)
                ArrFilter(n) = ArrData(r, 1)
            End If
        Next
        If n Then
            .ListBox1.List = ArrFilter
        Else
            .ListBox1.List = Array()
        End If
    End With
End Sub

Đồng thời, thay vì bạn dùng sự kiện Change thì bạn xóa đi, và dùng sự kiện KeyUp xem sao!

Private Sub TextBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    loc
End Sub

Rất cảm ơn bạn đã giúp. Code vẫn nặng y như cũ bạn ak, bạn còn cách nào khác không chứ tên hàng của mình gần 5000 nghàn thì code lọc rất lâu có khi lại đứng máy luôn

 

[Hoàng Trọng Nghĩa]

Rất cảm ơn bạn đã giúp. Code vẫn nặng y như cũ bạn ak, bạn còn cách nào khác không chứ tên hàng của mình gần 5000 nghàn thì code lọc rất lâu có khi lại đứng máy luôn

Mình dùng tuyệt chiêu của anh Bill: AutoFilter

Nhanh đến chóng mặt! Cho ý kiến khi áp dụng dữ liệu thật nhé!

Sub Loc()
    Dim r As Long
    Dim RngData As Range
    r = Sheets("tenhang").Range("A" & Rows.Count).End(xlUp).Row
    Set RngData = Sheets("tenhang").Range("A1:A" & r)
    With Sheets("Sheet1")
        RngData.AutoFilter 1, "*" & .TextBox1 & "*"
        With [COLOR=#ff0000]Sheets("TempSheet")[/COLOR]
            .Columns(1).Clear
            RngData.Copy .Range("A1")
            r = .Range("A" & Rows.Count).End(xlUp).Row
            .Range("A2:A" & r).Name = "RngFilter"
        End With
        If r = 1 Then
            .ListBox1.ListFillRange = ""
        Else
            .ListBox1.ListFillRange = "RngFilter"
        End If
    End With
End Sub

Lưu ý với dòng màu đỏ!!!

 

[congnguyen88]

Mình dùng tuyệt chiêu của anh Bill: AutoFilter

Nhanh đến chóng mặt! Cho ý kiến khi áp dụng dữ liệu thật nhé!

Sub Loc()
    Dim r As Long
    Dim RngData As Range
    r = Sheets("tenhang").Range("A" & Rows.Count).End(xlUp).Row
    Set RngData = Sheets("tenhang").Range("A1:A" & r)
    With Sheets("Sheet1")
        RngData.AutoFilter 1, "*" & .TextBox1 & "*"
        With [COLOR=#ff0000]Sheets("TempSheet")[/COLOR]
            .Columns(1).Clear
            RngData.Copy .Range("A1")
            r = .Range("A" & Rows.Count).End(xlUp).Row
            .Range("A2:A" & r).Name = "RngFilter"
        End With
        If r = 1 Then
            .ListBox1.ListFillRange = ""
        Else
            .ListBox1.ListFillRange = "RngFilter"
        End If
    End With
End Sub

Lưu ý với dòng màu đỏ!!!

Code chạy rất tốt , nhanh , nhưng nó lọc không giống như ý của mình rồi bạn Nghĩa ak
Code của mình lọc như sau:
1. Gõ bất cứ từ gì dù đứng đầy câu hay cuối câu nó se hiện ra hết
2. Gõ chữ không phân biệt chữ hoa chữ thường, không phân biệt chữ có dấu và không dấu

Bạn có thể sữa lại giống như đoạn code này ( code này bữa bạn giúp mình đó, còn nhớ không )

If LCase(TV(dl(i, 1))) Like LCase(TV("*" & Sheet1.TextBox1.Value & "*")) Then

http://www.giaiphapexcel.com/forum/...n-biệt-chử-hoa-chử-thường&p=606336#post606336

 

[congnguyen88]

Code chạy rất tốt , nhanh , nhưng nó lọc không giống như ý của mình rồi bạn Nghĩa ak
Code của mình lọc như sau:
1. Gõ bất cứ từ gì dù đứng đầy câu hay cuối câu nó se hiện ra hết
2. Gõ chữ không phân biệt chữ hoa chữ thường, không phân biệt chữ có dấu và không dấu

Bạn có thể sữa lại giống như đoạn code này ( code này bữa bạn giúp mình đó, còn nhớ không )

If LCase(TV(dl(i, 1))) Like LCase(TV("*" & Sheet1.TextBox1.Value & "*")) Then

http://www.giaiphapexcel.com/forum/...n-biệt-chử-hoa-chử-thường&p=606336#post606336

Nếu Code khó quá bạn làm không được thì mình nghĩ còn 1 cách là
mình sẽ tạo 1 cột phụ ( Chẳng hạn cột B đi , cột này mình sẽ dùng COde trim dấu tiếng việt )
sau đó mình sẽ lọc trên cột phụ này cho dễ dàng . Nhưng khi lấy kết quả chắc mình phải dùng hàm Vlookup phải không anh Nghĩa

 

[Hoàng Trọng Nghĩa]

Nếu Code khó quá bạn làm không được thì mình nghĩ còn 1 cách là
mình sẽ tạo 1 cột phụ ( Chẳng hạn cột B đi , cột này mình sẽ dùng COde trim dấu tiếng việt )
sau đó mình sẽ lọc trên cột phụ này cho dễ dàng . Nhưng khi lấy kết quả chắc mình phải dùng hàm Vlookup phải không anh Nghĩa

Tôi nghĩ phải dùng đến cột phụ, nhưng cần quái gì đến hàm VLOOKUP chứ!

1. Gõ bất cứ từ gì dù đứng đầy câu hay cuối câu nó se hiện ra hết

Cái này thì có à nha, kiểm tra lại đi.

2. Gõ chữ không phân biệt chữ hoa chữ thường, không phân biệt chữ có dấu và không dấu

Chỉ cái này là phải làm cột phụ thôi.

Đôi khi suy nghĩ cả đêm mới có phương án thực hiện, nhưng hầu như không nhận được một cái nhấn CÁM ƠN là sao ta???

 

[congnguyen88]

Tôi nghĩ phải dùng đến cột phụ, nhưng cần quái gì đến hàm VLOOKUP chứ!



Cái này thì có à nha, kiểm tra lại đi.



Chỉ cái này là phải làm cột phụ thôi.

Đôi khi suy nghĩ cả đêm mới có phương án thực hiện, nhưng hầu như không nhận được một cái nhấn CÁM ƠN là sao ta???

Chết mình mãi mê nghiên cứu , thật tình mình quên, bạn là 1 một người mình rất thích và mếm trên diễn đàn , cảm ơn bạn rât nhiều anh Nghĩa ak ( em quên chứ không phải không nhấn nút Cảm ơn )

2. Gõ chữ không phân biệt chữ hoa chữ thường, không phân biệt chữ có dấu và không dấu

chữ hoa chữ thường, thì ok, nhưng chử có dấu không phân biệt anh ak, em đã text rồi, Mong anh giúp em thì giúp cho trọn luôn, Cảm ơn anh

 

[Hoàng Trọng Nghĩa]

1) Tạo một cột phụ trong sheet TenHang, dùng hàm loại dấu tiếng Việt, copy cột này rồi paste value

2) Thay vì tôi làm code trong sub Loc, thì tôi làm trực tiếp trong sự kiện Change luôn, và xóa Loc đi:

Private Sub TextBox1_Change()
    If TextBox1 = "" Then
        ListBox1.ListFillRange = ""
    Else
        Application.ScreenUpdating = False
        Application.EnableEvents = False
        
        Dim r As Long
        Static RngData As Range
        
        If RngData Is Nothing Then
            r = Sheets("tenhang").Range("A" & Rows.Count).End(xlUp).Row
[COLOR=#0000cd][B]            Set RngData = Sheets("tenhang").Range("A1:[/B][/COLOR][COLOR=#ff0000][B]C[/B][/COLOR][COLOR=#0000cd][B]" & r)[/B][/COLOR]
        End If
        
[COLOR=#0000cd][B]        RngData.AutoFilter [/B][/COLOR][COLOR=#ff0000][B]3[/B][/COLOR][COLOR=#0000cd][B], "*" & [/B][/COLOR][COLOR=#ff0000][B]TV(TextBox1)[/B][/COLOR][COLOR=#0000cd][B] & "*"[/B][/COLOR]
        
        With Sheets("TempSheet")
            .Range("A:B").Clear
[COLOR=#0000cd][B]            RngData[/B][/COLOR][COLOR=#ff0000][B].Resize(, 2)[/B][/COLOR][COLOR=#0000cd][B].Copy .Range("A1")[/B][/COLOR]
            r = .Range("A" & Rows.Count).End(xlUp).Row
[COLOR=#0000cd][B]            .Range("A2:[/B][/COLOR][COLOR=#ff0000][B]B[/B][/COLOR][COLOR=#0000cd][B]" & r).Name = "RngFilter"[/B][/COLOR]
        End With
        
        If r = 1 Then
            ListBox1.ListFillRange = ""
        Else
            ListBox1.ListFillRange = "RngFilter"
        End If
        
        Application.EnableEvents = True
        Application.ScreenUpdating = True
    End If
End Sub

Khi đã dùng sự kiện trên, thì sự kiện double click hoặc keydown của listbox (nhằm loại bỏ hàm VLOOKUP) sẽ như sau:

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Range("B2").Value = ListBox1.Value
[COLOR=#0000cd][B]    Range("D2").Value = ListBox1.List(, 1)[/B][/COLOR]
    Range("B3").Select
    Hide
End Sub

Private Sub ListBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode = 13 Then
        Range("B2").Value = ListBox1.Value
[COLOR=#0000cd][B]        Range("D2").Value = ListBox1.List(, 1)[/B][/COLOR]
        Hide
    End If
End Sub

Chết mình mãi mê nghiên cứu , thật tình mình quên, bạn là 1 một người mình rất thích và mếm trên diễn đàn , cảm ơn bạn rât nhiều anh Nghĩa ak ( em quên chứ không phải không nhấn nút Cảm ơn )

Cho tới thời điểm này cũng chưa thấy bạn nhấn nút cảm ơn cho những bài trước, chắc lại tại mãi mê nghiên cứu! Đối với tôi chả là gì cả, thi ân bất cầu báo, nhưng nhấn nút cám ơn, đó là một nét văn hóa đẹp khi bất cứ ai đó (chứ không phải riêng tôi) giúp cho bạn, để tôi hoặc người khác còn biết bạn đã đọc bài của mình hay chưa.

 

[congnguyen88]

Anh nghĩa ak, không phải là em không nhấn nút Cảm ơn , mấy bửa em nhấn nút cảm ơn thì nó hiện ra tên của em đã cảm ơn, không biết bây giớ nó bị gì máy của em không có hiện nút cảm ơn ( em đã đăng nhập rồi )

[Q