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

[Hoàng Trọng Nghĩa]

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):

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: 26/7/22

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:

            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.

 

[Hai Lúa Miền Tây]

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):

Anh thử lọc trên Recordset xem, nó sẽ cải thiện tốc độ hơn đó.

 

[vanlinh_2904]

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:

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)

ColFormat lstDanhSachVPP, priArrData, "#,##0", 4, 5

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

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)

MultiColumnFilter txtChuoiTK.Text, lstDanhSachVPP, priArrData

Em thấy code này rất hay, nhưng trường hợp của em cần lấy danh sách từ 2 sheet để đưa vào listbox. nhờ anh giúp em với ạ, em cảm ơn anh.

 

[Hoàng Nhật Phươ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:

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:

MultiColumnFilter txtChuoiTK.Text, lstDanhSachVPP, priArrData, "all"

Muốn chỉ lọc 2 cột:

MultiColumnFilter txtChuoiTK.Text, lstDanhSachVPP, priArrData, 1, 2

Lọc 1 cột duy nhất:

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.

Nhờ anh Nghĩa xem giúp với, nếu danh sách có 2 cột thì bị lỗi anh ạ.
Nếu sửa:
If arrSource(arrColNum(c), r) Like strText Then
Thành:
If arrSource(arrColNum(c) - 1, r) Like strText Then
Thì không còn lỗi nữa anh.

 

[Hoàng Trọng Nghĩa]

Nhờ anh Nghĩa xem giúp với, nếu danh sách có 2 cột thì bị lỗi anh ạ.
Nếu sửa:
If arrSource(arrColNum(c), r) Like strText Then
Thành:
If arrSource(arrColNum(c) - 1, r) Like strText Then
Thì không còn lỗi nữa anh.

Ủa, tự sửa hết lỗi rồi, đem lên đây hỏi làm gì trời? Code là để phục vụ cho mình, nếu nó thực hiện đúng ý đồ của mình rồi thì thắc mắc chi nữa???

 

[Hoàng Nhật Phương]

Ủa, tự sửa hết lỗi rồi, đem lên đây hỏi làm gì trời? Code là để phục vụ cho mình, nếu nó thực hiện đúng ý đồ của mình rồi thì thắc mắc chi nữa???

à hỏi xong thì OT mới biết sửa anh Nghĩa, như vậy OT sửa đúng rồi anh nhỉ ... hihi
Cảm ơn anh Nghĩa đẹp trai nhé ^^