Tìm kiếm khi gõ trên TextBox, lọc nhiều cột và trả kết quả lên Listbox

Liên hệ QC
Hoàng Trọng Nghĩa

Hoàng Trọng Nghĩa

Chuyên gia GPE
Thành viên BQT
Moderator
Tham gia
17/8/08
Bài viết
8,640
Được thích
16,699
Giới tính
Nam
Từ bài viết này:

Demo Form tìm kiếm nhiều cột trong Listbox​


Tôi chia sẻ thêm cách lọc nhiều cột bằng ADO (nhưng tôi đánh giá không cao vì tốc độ rất chậm):

PHP: 
Private Sub txtChuoiTK_Change()
    With txtChuoiTK
        If .Text = "" Then
            lstDanhSachVPP.Column = priArrData
        Else
            Dim strSQL As String
            On Error Resume Next
            priObjConnect.Open priStrADO
            strSQL = "SELECT [ID],[MaSP2],[TenSP],[Dvt],Format([GiaGoc],'#,##0'),[MinReorder] FROM [tblDMSP$] " & _
                     "WHERE [ID] LIKE '%" & .Text & "%' OR [MaSP2] LIKE '%" & .Text & "%' OR [TenSP] LIKE '%" & .Text & "%' " & _
                     "OR [Dvt] LIKE '%" & .Text & "%' OR [GiaGoc] LIKE '%" & .Text & "%' OR [MinReorder] LIKE '%" & .Text & "%'"
            priObjRecord.Open strSQL, priObjConnect, 1, 3
            If Not priObjRecord.EOF Then
                lstDanhSachVPP.Column = priObjRecord.GetRows()
            Else
                lstDanhSachVPP.Clear
            End If
            lstDanhSachVPP.AddItem Empty
            priObjRecord.Close
            priObjConnect.Close
        End If
    End With
End Sub
Bài đã được tự động gộp:

Nếu các bạn muốn sắp xếp (sort) theo cột nào thì thêm ORDER BY [tên cột] vào câu lệnh:

Rich (BB code): 
            strSQL = "SELECT [ID],[MaSP2],[TenSP],[Dvt],Format([GiaGoc],'#,##0'),[MinReorder] FROM [tblDMSP$] " & _
                     "WHERE [ID] LIKE '%" & .Text & "%' OR [MaSP2] LIKE '%" & .Text & "%' OR [TenSP] LIKE '%" & .Text & "%' " & _
                     "OR [Dvt] LIKE '%" & .Text & "%' OR [GiaGoc] LIKE '%" & .Text & "%' OR [MinReorder] LIKE '%" & .Text & "%' " & _
                     "ORDER BY [TenSP]"

Nhưng bài #1 này chủ yếu là có thể dùng ADO để lọc nhiều cột, tôi sẽ giới thiệu thuật toán lọc mới của tôi về chủ đề này ở bài #2. Nó vẫn có thể chạy mượt mà với 20.000 dòng.
 

File đính kèm

  • TimKiemListBox_nhieuCot(ADO)_NghiaDepTrai.xlsm
    2.6 MB · Đọc: 87
Lần chỉnh sửa cuối:
Sắp xếp theo thời gian sắp xếp theo bầu chọn
Như đã nói ở bài #1, bài này tôi viết code lại ngắn gọn và chạy nhanh chóng.

1) Thủ tục Format Number trong mảng:

Mã: 
Sub ColFormat(ByVal lstListBox As MSForms.ListBox, ByRef arrSource, ByVal strFormat As String, ParamArray arrColNum())
    Dim dblValue As Double
    Dim r As Long, ur As Long
    Dim c As Byte, uc As Byte
    ur = UBound(arrSource, 2): uc = UBound(arrColNum)
    For r = 0 To ur
        For c = 0 To uc
            dblValue = Val(arrSource(arrColNum(c), r))
            If dblValue = 0 Then
                arrSource(arrColNum(c), r) = 0
            Else
                arrSource(arrColNum(c), r) = Format(dblValue, strFormat)
            End If
        Next
    Next
    lstListBox.Column = arrSource
End Sub

Cấu trúc: (Tên thủ tục ListBox, Mảng cần thay đổi, Cách định dạnh, Các cột cần định dạng)
Mã: 
ColFormat lstDanhSachVPP, priArrData, "#,##0", 4, 5

2) Thủ tục lọc nhiều cột:

Mã: 
Sub MultiColumnFilter(ByVal strText As String, ByVal lstListBox As MSForms.ListBox, ByVal arrSource)
    If Not IsArray(arrSource) Then Exit Sub
    If strText = "" Then
        lstListBox.Column = arrSource
    Else
        Dim arrTmp()
        Dim c As Byte, uc As Byte, v As Byte
        Dim r As Long, ur As Long, n As Long
        ur = UBound(arrSource, 2): uc = UBound(arrSource, 1)
        strText = "*" & strText & "*"
        For r = 0 To ur
            For c = 0 To uc
                If arrSource(c, r) Like strText Then
                    ReDim Preserve arrTmp(0 To uc, 0 To n)
                    For v = 0 To uc
                        arrTmp(v, n) = arrSource(v, r)
                    Next
                    n = n + 1
                    Exit For
                End If
            Next
        Next
        If n Then lstListBox.Column = arrTmp Else lstListBox.Clear
    End If
    lstListBox.AddItem Empty
End Sub

Cấu trúc: (Tên thủ tục, Chuỗi cần tìm kiếm, ListBox nhận kết quả, Mảng nguồn)
Mã: 
MultiColumnFilter txtChuoiTK.Text, lstDanhSachVPP, priArrData
 

File đính kèm

  • TimKiemListBox_nhieuCot(dungArray) (NghiaDepTrai).xlsm
    1,007.9 KB · Đọc: 74
Lần chỉnh sửa cuối:
Upvote 0
Hoàng Trọng Nghĩa đã viết:
Như đã nói ở bài #1, bài này tôi viết code lại ngắn gọn và chạy nhanh chóng.

1) Thủ tục Format Number trong mảng:

Mã: 
Sub ColFormat(ByVal lstListBox As MSForms.ListBox, ByRef arrSource, ByVal strFormat As String, ParamArray arrColNum())
    Dim dblValue As Double
    Dim r As Long, ur As Long
    Dim c As Byte, uc As Byte
    ur = UBound(arrSource, 2): uc = UBound(arrColNum)
    For r = 0 To ur
        For c = 0 To uc
            dblValue = Val(arrSource(arrColNum(c), r))
            If dblValue = 0 Then
                arrSource(arrColNum(c), r) = 0
            Else
                arrSource(arrColNum(c), r) = Format(dblValue, strFormat)
            End If
        Next
    Next
    lstListBox.Column = arrSource
End Sub

Cấu trúc: (Tên thủ tục ListBox, Mảng cần thay đổi, Cách định dạnh, Các cột cần định dạng)
Mã: 
ColFormat lstDanhSachVPP, priArrData, "#,##0", 4, 5

2) Thủ tục lọc nhiều cột:

Mã: 
Sub MultiColumnFilter(ByVal strText As String, ByVal lstListBox As MSForms.ListBox, ByVal arrSource)
    If Not IsArray(arrSource) Then Exit Sub
    If strText = "" Then
        lstListBox.Column = arrSource
    Else
        Dim arrTmp()
        Dim c As Byte, uc As Byte, v As Byte
        Dim r As Long, ur As Long, n As Long
        ur = UBound(arrSource, 2): uc = UBound(arrSource, 1)
        strText = "*" & strText & "*"
        For r = 0 To ur
            For c = 0 To uc
                If arrSource(c, r) Like strText Then
                    ReDim Preserve arrTmp(0 To uc, 0 To n)
                    For v = 0 To uc
                        arrTmp(v, n) = arrSource(v, r)
                    Next
                    n = n + 1
                    Exit For
                End If
            Next
        Next
        If n Then lstListBox.Column = arrTmp Else lstListBox.Clear
    End If
    lstListBox.AddItem Empty
End Sub

Cấu trúc: (Tên thủ tục, Chuỗi cần tìm kiếm, ListBox nhận kết quả, Mảng nguồn)
Mã: 
MultiColumnFilter txtChuoiTK.Text, lstDanhSachVPP, priArrData
Nhấp chuột vào đây để mở rộng...
viết thêm chút nữa cho nó co và giản cột theo dữ liệu là hay đấy
1658897457789.png
 
Upvote 0
Upvote 0
Hoàng Trọng Nghĩa đã viết:
Từ bài viết này:

Demo Form tìm kiếm nhiều cột trong Listbox​


Tôi chia sẻ thêm cách lọc nhiều cột bằng ADO (nhưng tôi đánh giá không cao vì tốc độ rất chậm):

PHP: 
Private Sub txtChuoiTK_Change()
    With txtChuoiTK
        If .Text = "" Then
            lstDanhSachVPP.Column = priArrData
        Else
            Dim strSQL As String
            On Error Resume Next
            priObjConnect.Open priStrADO
            strSQL = "SELECT [ID],[MaSP2],[TenSP],[Dvt],Format([GiaGoc],'#,##0'),[MinReorder] FROM [tblDMSP$] " & _
                     "WHERE [ID] LIKE '%" & .Text & "%' OR [MaSP2] LIKE '%" & .Text & "%' OR [TenSP] LIKE '%" & .Text & "%' " & _
                     "OR [Dvt] LIKE '%" & .Text & "%' OR [GiaGoc] LIKE '%" & .Text & "%' OR [MinReorder] LIKE '%" & .Text & "%'"
            priObjRecord.Open strSQL, priObjConnect, 1, 3
            If Not priObjRecord.EOF Then
                lstDanhSachVPP.Column = priObjRecord.GetRows()
            Else
                lstDanhSachVPP.Clear
            End If
            lstDanhSachVPP.AddItem Empty
            priObjRecord.Close
            priObjConnect.Close
        End If
    End With
End Sub
Bài đã được tự động gộp:

Nếu các bạn muốn sắp xếp (sort) theo cột nào thì thêm ORDER BY [tên cột] vào câu lệnh:

Rich (BB code): 
            strSQL = "SELECT [ID],[MaSP2],[TenSP],[Dvt],Format([GiaGoc],'#,##0'),[MinReorder] FROM [tblDMSP$] " & _
                     "WHERE [ID] LIKE '%" & .Text & "%' OR [MaSP2] LIKE '%" & .Text & "%' OR [TenSP] LIKE '%" & .Text & "%' " & _
                     "OR [Dvt] LIKE '%" & .Text & "%' OR [GiaGoc] LIKE '%" & .Text & "%' OR [MinReorder] LIKE '%" & .Text & "%' " & _
                     "ORDER BY [TenSP]"

Nhưng bài #1 này chủ yếu là có thể dùng ADO để lọc nhiều cột, tôi sẽ giới thiệu bài thật sự của tôi về chủ đề này ở bài #2. Nó vẫn có thể chạy mượt mà với 20.000 dòng.
Nhấp chuột vào đây để mở rộng...
Nên xử lý chỗ nhỏ này nữa anh.

1658900678768.png
 
Upvote 0
Upvote 0
Hoàng Trọng Nghĩa đã viết:
Từ bài viết này:

Demo Form tìm kiếm nhiều cột trong Listbox​


Tôi chia sẻ thêm cách lọc nhiều cột bằng ADO (nhưng tôi đánh giá không cao vì tốc độ rất chậm):


Nhưng bài #1 này chủ yếu là có thể dùng ADO để lọc nhiều cột, tôi sẽ giới thiệu thuật toán lọc mới của tôi về chủ đề này ở bài #2. Nó vẫn có thể chạy mượt mà với 20.000 dòng.
Nhấp chuột vào đây để mở rộng...
Bạn Nghĩa nên nói thêm là dùng ADO sẽ phù hợp khi nguồn dữ liệu là từ bên ngoài Excel như Access, SQLLite, My SQL....Khi đó Excel chỉ là Font end để tương tác với người dùng. Nếu gặp trường hợp kết nối qua mạng (LAN, WAN) thì dùng câu lệnh SQL với kết nối ADO sẽ kiểm soát được số lượng dòng, cột, thông tin cần tải về.
 
Upvote 0
Trên nền code có sẳn của @Hoàng Trọng Nghĩa đẹp trai tôi vẻ thêm vài cái Control xong viết thêm ít dòng code + cái DLL của tôi là nó lấy + lọc nhiều CSDL thôi ... ko có gì khó khăn cả ... nay tạm vẻ chút ... rảnh làm tiếp
thong thả câu giờ chơi cho vui thui có đi đâu mà vội

1658907894425.png
 
Upvote 0
Kiều Mạnh đã viết:
Trên nền code có sẳn của @Hoàng Trọng Nghĩa đẹp trai tôi vẻ thêm vài cái Control xong viết thêm ít dòng code + cái DLL của tôi là nó lấy + lọc nhiều CSDL thôi ... ko có gì khó khăn cả ... nay tạm vẻ chút ... rảnh làm tiếp
thong thả câu giờ chơi cho vui thui có đi đâu mà vội

View attachment 279338
Nhấp chuột vào đây để mở rộng...
Anh biết tại sao tôi không dùng SELECT * FROM mà liệt kê tất cả các cột trong file đó ra không?
 
Upvote 0
Kiều Mạnh đã viết:
Trên nền code có sẳn của @Hoàng Trọng Nghĩa đẹp trai tôi vẻ thêm vài cái Control xong viết thêm ít dòng code + cái DLL của tôi là nó lấy + lọc nhiều CSDL thôi ... ko có gì khó khăn cả ... nay tạm vẻ chút ... rảnh làm tiếp
thong thả câu giờ chơi cho vui thui có đi đâu mà vội
Nhấp chuột vào đây để mở rộng...
Cái Form thiết kế dạng này là một phần nhỏ trong ứng dụng người dùng thì thêm Select này nọ vô làm gì? Form hướng dẫn tận răng họ còn thao tác sai thì lấy gì mà tự code câu lệnh SQL.
Cái Dll của bạn nên đưa nó vô một bộ code (class hay module gì cũng được) rồi cung cấp cho người lập trình, họ có thể sử dụng bộ code đó để viết ứng dụng tương tác với các loại CSDL khác nhau. Bộ code gồm các hàm thực hiện các chức năng như: xem, thêm, sửa, xóa, lọc...Cái nào sử dụng chung cho các loại CSDL thì viết chung, cái nào đặc thù thì viết hàm riêng như: gọi View, chạy Store procedure trong SQL Server...
Trên GPE này tôi cũng đã có chia sẻ mấy bài nếu để ý thì sẽ thấy tôi đều dùng chung có 1 bộ code (module) kết nối SQL Server, Access, Foxpro để tương tác dữ liệu thôi đó, khỏi phải viết đi viết lại mất thời gian.

Ví dụ: một số hàm đã dùng trong các bài liên quan kết nối CSDL

CleanShot 2022-07-27 at 15.48.22@2x.jpg

SQL: 
Public Function ExecuteActionQuery(SQLToExecute As String, Optional CloseDatabase As Boolean = True) As Boolean
'//Dung de thuc thi cau lenh Action Query SQL'

    Dim oCmd As Object
    Dim blnReturn As Boolean
    blnReturn = True

    On Error GoTo EAQError

        Set oCmd = CreateObject("ADODB.Command")
        With oCmd
            .CommandType = 1
            Set .ActiveConnection = oConn
            .CommandText = SQLToExecute
            .Prepared = True
            .Execute
        End With
    
    Exit Function

EAQResume:
    On Error Resume Next
    If CloseDatabase Or Not blnReturn Then CloseDB
    ExecuteActionQuery = blnReturn
    Exit Function

EAQError:
    blnReturn = False
    MsgBox "Ma loi: " & Err.Number & vbCrLf & "Noi dung: " & Err.Description, vbCritical + vbSystemModal, "ExecuteActionQuery"
    Resume EAQResume

End Function
 
Lần chỉnh sửa cuối:
Upvote 0
Kiều Mạnh đã viết:
chưa có xem kỹ hình như liên quan tiêu đề + cái name
Nhấp chuột vào đây để mở rộng...
Do cột GiaGoc phải định dạng #,##0 nên mới phải kéo theo các cột kia luôn.
Bài đã được tự động gộp:

Kiều Mạnh đã viết:
ko nói cái đó mà nói ý là thêm co và giản cột vừa với dữ liệu hiện có trên Listbox ấy cho nó đẹp chút thôi
Nhấp chuột vào đây để mở rộng...
Nó co giản cũng không phải khó, nhưng vốn dĩ mình làm biếng làm thôi anh.

 
Upvote 0
ongke0711 đã viết:
Cái Form thiết kế dạng này là một phần nhỏ trong ứng dụng người dùng thì thêm Select này nọ vô làm gì? Form hướng dẫn tận răng họ còn thao tác sai thì lấy gì mà tự code câu lệnh SQL.
Cái Dll của bạn nên đưa nó vô một bộ code (class hay module gì cũng được) rồi cung cấp cho người lập trình, họ có thể sử dụng bộ code đó để viết ứng dụng tương tác với các loại CSDL khác nhau. Bộ code gồm các hàm thực hiện các chức năng như: xem, thêm, sửa, xóa, lọc...Cái nào sử dụng chung cho các loại CSDL thì viết chung, cái nào đặc thù thì viết hàm riêng như: gọi View, chạy Store procedure trong SQL Server...
Trên GPE này tôi cũng đã có chia sẻ mấy bài nếu để ý thì sẽ thấy tôi đều dùng chung có 1 bộ code (module) kết nối SQL Server, Access, Foxpro để tương tác dữ liệu thôi đó, khỏi phải viết đi viết lại mất thời gian.

Ví dụ: một số hàm đã dùng trong các bài liên quan kết nối CSDL

View attachment 279345

SQL: 
Public Function ExecuteActionQuery(SQLToExecute As String, Optional CloseDatabase As Boolean = True) As Boolean
'//Dung de thuc thi cau lenh Action Query SQL'

    Dim oCmd As Object
    Dim blnReturn As Boolean
    blnReturn = True

    On Error GoTo EAQError

        Set oCmd = CreateObject("ADODB.Command")
        With oCmd
            .CommandType = 1
            Set .ActiveConnection = oConn
            .CommandText = SQLToExecute
            .Prepared = True
            .Execute
        End With
   
    Exit Function

EAQResume:
    On Error Resume Next
    If CloseDatabase Or Not blnReturn Then CloseDB
    ExecuteActionQuery = blnReturn
    Exit Function

EAQError:
    blnReturn = False
    MsgBox "Ma loi: " & Err.Number & vbCrLf & "Noi dung: " & Err.Description, vbCritical + vbSystemModal, "ExecuteActionQuery"
    Resume EAQResume

End Function
Nhấp chuột vào đây để mở rộng...
tôi đang nháp thử ra đó xong thử các kiểu xem sao đó thôi ... có gì đâu mà lôi tràng giang đại hải ra thế he

Mai rảnh tôi thử tải cái ListBox với số dòng hiện có trên Excel xem tình hình sao nếu đơ hoặc thoát thì tôi cũng ko quan tâm nữa ... chạy thôi

VD: 1048570 dòng x 12 cột thôi ... xem Listbox có chịu nổi nhiệt hay không ... xong sau đó là tốc độ chạy

Còn vài hàm ADO cổ điển ko có gì đặc biệt thì tôi cũng làm biếng dòm lắm và nay cũng ít quan tâm luôn trừ khi có gì mới đặc biệt thì còn xem học thuật toán ... còn ko làm biếng dòm vì tôi dùng FireDAC của Delphi rồi :p:D
 
Upvote 0
Kiều Mạnh đã viết:
tôi đang nháp thử ra đó xong thử các kiểu xem sao đó thôi ... có gì đâu mà lôi tràng giang đại hải ra thế he

Mai rảnh tôi thử tải cái ListBox với số dòng hiện có trên Excel xem tình hình sao nếu đơ hoặc thoát thì tôi cũng ko quan tâm nữa ... chạy thôi

VD: 1048570 dòng x 12 cột thôi ... xem Listbox có chịu nổi nhiệt hay không ... xong sau đó là tốc độ chạy

Còn vài hàm ADO cổ điển ko có gì đặc biệt thì tôi cũng làm biếng dòm lắm và nay cũng ít quan tâm luôn trừ khi có gì mới đặc biệt thì còn xem học thuật toán ... còn ko làm biếng dòm vì tôi dùng FireDAC của Delphi rồi :p:D
Nhấp chuột vào đây để mở rộng...
:D :D Vậy là bạn cũng chưa hiểu vấn đề của bạn rồi.
Cái tôi nói ở trên chỉ là định hướng của cái thư viện mà bạn khoe bữa giờ, còn viết bằng ngôn ngữ gì là chuyện của bạn. Đi với bụt bận áo cà sa, đi với ma bận áo giấy thôi. Xây dụng ứng dụng trên C#, VB.net thì dùng thư viện đi kèm với nó, Delphi thì dùng của Delphi, thằng VBA thì có thể xài ké các thư viện khác nếu nó chuyển thành COM. Vấn đề là cái DLL viết ra có người tích hợp và xài được với ứng dụng của họ hay không, chứ viết ra mà không ai xài thì có ích gì đâu cho dù nó nhanh nhất, tốt nhất nhưng không ai có nhu cầu với nó thì cũng vứt.
Chẳng hạn như chuyện test Listbox với hơn 1tr dòng để làm gì, để cho biết vậy thôi chứ có ông lập trình nào đi viết cái ứng dụng có cái Listbox tải 1tr dòng???
Còn các hàm ADO chỉ là những hàm UDF để giải quyết một vấn đề nào đó của CSDL, dùng ngôn ngữ nào thì cũng quanh quẩn các giải thuật đó thôi, tùy thư viện mà cách gọi, thực thi câu lệnh SQL khác nhau. SQL server, mySQL thì cũng lòng vòng các câu lệnh SQL: Insert into, Update, Delete...Không có cái nào hiện đại hơn đâu. Chắc là bạn dùng FireDac chạy các câu lệnh SQL khác hiện đại để tương tác với SQL Server chứ không dùng Insert into...cổ điển của nó. Nếu vậy thì bạn giỏi rồi, cứ viết ra bộ thư viện chia sẻ hay bán rồi xem người dùng hay ông lập trình nào tiếp nhận, sử dụng thì biết ngay thôi đó mà. Trình độ Delphi của bạn vậy thì nên tham gia các diễn đàn chuyên về Delphi sẽ có đất dụng võ chứ vô GPE mà gặp mấy anh em như tôi chỉ biết có mỗi VBA, thì khác gì vịt nghe sấm.
Chắc là giờ bạn không còn dòm tới cái VB6 cổ điển mà trước đây bạn đã từng tung hô mãi mãi trường tồn nữa rồi đúng không! :D
 
Lần chỉnh sửa cuối:
Upvote 0
ongke0711 đã viết:
Trình độ Delphi của bạn vậy thì nên tham gia các diễn đàn chuyên về Delphi sẽ có đất dụng võ chứ vô GPE mà gặp mấy anh em như tôi chỉ biết có mỗi VBA, thì khác gì vịt nghe sấm.
Nhấp chuột vào đây để mở rộng...
Tham gia diễn đàn Excel thì còn khoe được mấy cái cóp nhặt được chứ mang lên diễn đàn Delphi có khi người ta lại cười cho. Mà khoe trên diễn đàn Delphi là phải khoe code chứ có phải chỉ khoe DLL lòe người khác như trên diễn đàn Excel đâu. Tôi không nói tới riêng ai cả, không nói tới người cụ thể. Có thể là nói cả tới những người như tôi.
 
Upvote 0
Hoàng Trọng Nghĩa đã viết:
2) Thủ tục lọc nhiều cột:

Mã: 
Sub MultiColumnFilter(ByVal strText As String, ByVal lstListBox As MSForms.ListBox, ByVal arrSource)
    If Not IsArray(arrSource) Then Exit Sub
    If strText = "" Then
        lstListBox.Column = arrSource
    Else
        Dim arrTmp()
        Dim c As Byte, uc As Byte, v As Byte
        Dim r As Long, ur As Long, n As Long
        ur = UBound(arrSource, 2): uc = UBound(arrSource, 1)
        strText = "*" & strText & "*"
        For r = 0 To ur
            For c = 0 To uc
                If arrSource(c, r) Like strText Then
                    ReDim Preserve arrTmp(0 To uc, 0 To n)
                    For v = 0 To uc
                        arrTmp(v, n) = arrSource(v, r)
                    Next
                    n = n + 1
                    Exit For
                End If
            Next
        Next
        If n Then lstListBox.Column = arrTmp Else lstListBox.Clear
    End If
    lstListBox.AddItem Empty
End Sub

Cấu trúc: (Tên thủ tục, Chuỗi cần tìm kiếm, ListBox nhận kết quả, Mảng nguồn)
Mã: 
MultiColumnFilter txtChuoiTK.Text, lstDanhSachVPP, priArrData
Nhấp chuột vào đây để mở rộng...
Từ bài trên, tôi cải tiến nó lại linh hoạt là chúng ta cần lọc cột nào, một hay nhiều cột hay lọc tất cả các cột cho nó đỡ phí thời gian, code như sau:
Mã: 
Sub MultiColumnFilter(ByVal strText As String, ByVal lstListBox As MSForms.ListBox, ByVal arrSource, ParamArray arrColNum())
    If Not IsArray(arrSource) Then Exit Sub
    If strText = "" Then
        lstListBox.Column = arrSource
    Else
        Dim arrTmp()
        Dim c As Byte, uc As Byte, v As Byte
        Dim r As Long, ur As Long, n As Long
        ur = UBound(arrSource, 2): uc = UBound(arrSource, 1)
        strText = "*" & strText & "*"
        If LCase(arrColNum(0)) = "all" Then
            For r = 0 To ur
                For c = 0 To uc
                    If arrSource(c, r) Like strText Then
                        ReDim Preserve arrTmp(0 To uc, 0 To n)
                        For v = 0 To uc
                            arrTmp(v, n) = arrSource(v, r)
                        Next
                        n = n + 1
                        Exit For
                    End If
                Next
            Next
        Else
            Dim u As Byte
            u = UBound(arrColNum)
            For r = 0 To ur
                For c = 0 To u
                    If arrSource(arrColNum(c), r) Like strText Then
                        ReDim Preserve arrTmp(0 To uc, 0 To n)
                        For v = 0 To uc
                            arrTmp(v, n) = arrSource(v, r)
                        Next
                        n = n + 1
                        Exit For
                    End If
                Next
            Next
        End If
        If n Then lstListBox.Column = arrTmp Else lstListBox.Clear
    End If
    lstListBox.AddItem Empty
End Sub

Khi đó, nếu muốn cột nào cũng lọc thì cấu trúc như sau:
Rich (BB code): 
MultiColumnFilter txtChuoiTK.Text, lstDanhSachVPP, priArrData, "all"
Muốn chỉ lọc 2 cột:
Rich (BB code): 
MultiColumnFilter txtChuoiTK.Text, lstDanhSachVPP, priArrData, 1, 2
Lọc 1 cột duy nhất:
Rich (BB code): 
MultiColumnFilter txtChuoiTK.Text, lstDanhSachVPP, priArrData, 2

Lưu ý: Mảng của tôi thiết kế là mảng bắt đầu từ số 0 (kể cả chiều ngang lẫn chiều dọc), vì thế chọn cột nếu chọn cột 1 thì ghi là 0 nhé, tương tự với các cột khác.
 

File đính kèm

  • TimKiemListBox_nhieuCot(dungArray) (NghiaDepTrai-New).xlsm
    1,009 KB · Đọc: 92
Lần chỉnh sửa cuối:
Upvote 0
Không biết có đúng chủ đề này không nhưng tôi đọc qua thấy dính dáng tới lọc nhiều cột ListBox.

Tôi viết gần 2,5 năm trước - Sub FindMultiCol_to_ListBox, bài #6

www.giaiphapexcel.com

Hỏi về cách lọc dữ liệu và sau đó trích xuất dữ liệu ra sheet khác!

Em có file như đính kèm, và có 1 vài mong muốn được trợ giúp: 1. Ở sheet VBA: Cách tìm kiếm dữ liệu trên 2 hoặc nhiều cột 1 lúc, em đã làm bằng cách chạy form và sử dụng hàm BS_functions của A-Toll bản free (giới hạn tìm được là 200 dòng dữ liệu). Nhưng nếu không sử dụng hàm của A-Tool mà chạy...
www.giaiphapexcel.com www.giaiphapexcel.com
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

xuannguyet968
  • Đã khóa
xin các cao nhận giúp mình với
    • Phẫn nộ
Trả lời
9
Đọc
215
Hoàng Trọng Nghĩa
Hoàng Trọng Nghĩa
N
Tách dữ liệu từ 1 cột sang nhiều cột
Trả lời
0
Đọc
1
nguyenvanthao2002
N
Mr.hieudoanxd
Khôi phục lại giao diện Excel về như cũ
Trả lời
16
Đọc
181
Mr.hieudoanxd
Mr.hieudoanxd
lehuong1409
  • Question
Tìm các sản phẩm có doanh thu cao nhất theo từng nhóm hàng (sử dụng Power Query)
Trả lời
15
Đọc
255
DeTong
D
Nguyễn Duy Tuân
BS Barcode To PC - Quét barcode từ điện thoại vào máy tính
    • Yêu thích
    • Thích
Trả lời
0
Đọc
39
Nguyễn Duy Tuân
Nguyễn Duy Tuân
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom