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

[ongke0711]

Form tìm kiếm listbox thì diễn đàn cũng có nhiều bài rồi nhưng nó nằm chung trong các bài hỏi của thành viên nên tìm cũng mệt . Vừa làm vừa học nên tôi tạo cái post này cho dễ tìm kiếm và nhờ các anh em giúp cải thiện cái form này cho chạy trơn tru và thuận tiện nhé.
- Form dùng tìm kiếm theo nhiều cột trong listbox. Chỉ cần gõ ký tự chuỗi bất kỳ, nó sẽ tìm trong tất cả các cột để lấy ra dòng có chứa chuỗi.
- Viết dạng hàm để có thể gọi sử dụng lại ở nhiều form.

Điểm chưa làm được:
- Chưa định dạng được dữ liệu hiển thị từng cột trong listbox (dùng mảng gán row source cho listbox). Cụ thể trong demo là cột [Đơn giá]: không có định dạng số (dấu cách phần ngàn .000).
- Chưa tuỳ chọn Sort dữ liệu tự động (theo cột đã chọn) trong listbox sau khi tìm kiếm (có tham khảo mấy hàm bubble sort trên mạng nhưng tích hợp vô).

Bạn nào chỉ cần tìm kiếm dữ liệu thì tôi nghĩ form này đáp ứng yêu cầu.
Các bạn hỗ trợ bổ sung thiết kế giùm nhé. File đính kèm bên dưới.
Cảm ơn.


Code cho Userform:

Option Explicit

Dim oRngLstBx1 As Range

Private Sub txtChuoiTK_Change()
    Dim strTextSearch As String

    strTextSearch = Me.txtChuoiTK.Value
    Call faytLstBxMultiCol(oRngLstBx1, strTextSearch, "lstDanhSachVPP", Me)

End Sub

Private Sub UserForm_Initialize()
    ganSourceListbox
    Me.txtChuoiTK.SetFocus
End Sub


Sub ganSourceListbox()

    Dim sArr() As Variant

    Set oRngLstBx1 = Range(Range("A2"), Range("A2").End(xlDown).End(xlToRight))     'Khai báo cho biesn toàn cuc de su dung cho hàm TK
    ReDim sArr(1 To oRngLstBx1.Rows.Count, 1 To oRngLstBx1.Columns.Count)

    sArr = oRngLstBx1.Value
    Me.lstDanhSachVPP.List = sArr

End Sub

- Hàm faytLstBxMultiCol():

Option Explicit

Function faytLstBxMultiCol(oLstBxRng As Range, strSearchTxt As String, strLstBxName As String, frm As UserForm) As Boolean
'----------------------------------------------------------
'# Hàm tim kiem,loc danh sach listbox theo chuoi tìm kiem.
'# oLstBxRng:       là Range làm Row Source cho Listbox.
'# strSearchTxt:    Chuoi can tim (tu textbox).
'# strLstBxName:    Ten cua listbox control tren userform.
'----------------------------------------------------------

On Error GoTo EH

    Dim sArr() As Variant
    Dim blnFound As Boolean 'bien neu tim thay chuoi can tìm
    Dim i As Long, j As Long, rCount As Long
    Dim oLstBx As Object

    faytLstBxMultiCol = False
    Set oLstBx = frm.Controls(strLstBxName)

    ReDim sArr(1 To oLstBxRng.Columns.Count, 1 To oLstBxRng.Rows.Count)

    For i = 1 To oLstBxRng.Rows.Count
        blnFound = False
        For j = 1 To oLstBxRng.Columns.Count
            If InStr(1, oLstBxRng.Cells(i, j).Value, strSearchTxt, vbTextCompare) > 0 Then  'Tim kiem chuoi tung dong, cot
                blnFound = True     'Tim thay chuoi
                Exit For
            End If
        Next j
        If blnFound Then
            rCount = rCount + 1     'Luu tong so dòng tìm hay chuoi
            For j = 1 To oLstBxRng.Columns.Count
                sArr(j, rCount) = oLstBxRng.Cells(i, j).Value   'Dua tri tim duoc vao mang, luu hang ngang
            Next j
        End If
    Next i

    'Khai bao lai kich thuoc mang theo so dong tim thay chuoi
    If rCount > 0 Then
        ReDim Preserve sArr(1 To j - 1, 1 To rCount)
    Else    'Khong tim thay dòng nào chua chuoi tk
        ReDim Preserve sArr(1 To j - 1, 1 To 1)
    End If

    If UBound(sArr, 2) > 1 Then     'Mang co nhieu gia tri giong chuoi tim kiem
        sArr = Application.WorksheetFunction.Transpose(sArr)
        oLstBx.List = sArr
    Else    'Mang tra ve chinh xác 1 giá tri tim kiem
        oLstBx.Clear
        oLstBx.AddItem
        For i = 1 To UBound(sArr)
            oLstBx.Column(i - 1, 0) = sArr(i, 1)
        Next i
    End If

    faytLstBxMultiCol = True
    Exit Function

EH_Exit:
    faytLstBxMultiCol = False
    Exit Function
EH:
    MsgBox "Loi: " & Err.Number & vbNewLine & "Noi dung loi: " & Err.Description
    Resume EH_Exit

End Function

++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

Bổ sung: (sau thời gian mò mẫm thêm )
- Thêm phần định các cột kiểu số (number) trong listbox với dấu phân cách hàng ngàn.
- Hàm dùng định dạng cột kiểu số trong listbox với tuỳ chọn nhiều cột.
(Đã đính kèm thêm file có định dạng cột)

Mình cũng có sưu tầm được một Class dùng để "canh lề" từng cột trong listbox riêng biệt (hiện nay Listbox chỉ cho phép canh lề một kiểu, áp dụng cho toàn bộ listbox) nhưng khi chạy thấy nó tải dữ liệu lên listbox chậm nên không đưa vô đây.
Giải thuật của các class này là xử lý từng cột -> từng record -> dùng label tạm để lưu nội dung record, thêm dấu cách vào trước, sau hoặc 2 bên để canh phải, trái, giữa rồi lưu lại nội dung vừa sửa vào listbox. Danh sách có 200 dòng mà nó chạy vòng lập cũng mất ~ 2s nên thôi bỏ qua giải pháp này.

Code hàm formatNumColumnLstBx() :

Function formatNumColumnLstBx(sLstBxName As String, sColNumList As String, frm As UserForm, sNumFormat As String)

'----------------------------------------------------------------
'# Muc dích: dùng dinh dang các cot kieu Number trong listbox và dùng trong truong hop dùng Mang (Array) gan du lieu cho LstBox.
'# Tham so:
'#   - sColNumList: danh sách các cot can dinh dang So, cách nhau dau phay ','. Vd: "4,5,6".
'#   - sNumFormat:  kieu dinh dang so. Vd: "#,##0": "#,##0.00" hoac "$#,##0.00"
'----------------------------------------------------------------

    Dim arColNumList As Variant
    Dim lngIndex As Long, i As Integer, intColNum As Integer

    If sColNumList = "" Then Exit Function

    arColNumList = Split(sColNumList, ",")

    With frm.Controls(sLstBxName)
        For i = LBound(arColNumList) To UBound(arColNumList)
            intColNum = Val(Trim(arColNumList(i)))          'Trim de bo loi khoang trang neu co
            If intColNum > .ColumnCount Then Exit Function  'Neu so thu tu cot khong có trong listbox se bao loi
            For lngIndex = 0 To .ListCount - 1
                .List(lngIndex, intColNum - 1) = (Format(Val(.List(lngIndex, intColNum - 1)), sNumFormat))
            Next
        Next i
    End With
End Function

+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

Cập nhật: 06/06/2019

Đã cập nhật file mới sử dụng code (dùng mảng) của bạn befaint để tối ưu tốc độ tìm kiếm.

+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

Cập nhật: 09/06/2019

Cập nhật thêm file mới sử dụng code (dùng mảng) của bạn HeSanbi rất ngắn gọn và bẫy lỗi khi range dữ liệu cho listbox không có data.


(***PS: tôi vẫn giữa các file phiên bản khác nhau để các tham khảo code các kiểu)

 

[Kiều Mạnh]

Dạ em thêm dòng trống như anh hướng dẫn vẫn không được anh
View attachment 279290

View attachment 279291

đoán thôi ha ... hình như muốn co và giản cột theo dữ liệu
nếu vậy tham khảo bài 392 link sau

Các câu hỏi về Form trong Excel VBA

Private Sub UserForm_Initialize() ....................... ....................... ....................... End Sub Em xin hỏi, sự kiện khí nào mình dùng sự kiện này Initialize Cám ơn

www.giaiphapexcel.com

 

[quyenpv]

Cái find_range_multiCol() trả về bao nhiêu cột vậy bạn?

Dạ 4 anh, em có thay đổi cột trong listbox =4 rồi mà vẫn bị ạ

 

[ongke0711]

Dạ 4 anh, em có thay đổi cột trong listbox =4 rồi mà vẫn bị ạ

Tổng độ rộng 4 cột có bằng độ rộng của 4 cái textbox tiêu đề không bạn?
Rồi bạn có cdoe thiết lập lại listbox width không?
Cái Form của bạn có tự co giãn theo độ phân giải màn hình không?
Ngồi đoán mò mệt quá.

 

[Hoàng Trọng Nghĩa]

Tổng độ rộng 4 cột có bằng độ rộng của 4 cái textbox tiêu đề không bạn?
Rồi bạn có cdoe thiết lập lại listbox width không?
Cái Form của bạn có tự co giãn theo độ phân giải màn hình không?
Ngồi đoán mò mệt quá.

Trước tiên phải xác định co giản theo cột nào? Tại sao 6 cột lại biến thành 4 cột, nếu co giản mà không bị mất cột cần phải tính giải pháp giản cột nào và co cột nào, đảm bảo tổng chiều rộng các cột phải bằng chiều rộng của ListBox ban đầu fix với chiều rộng của UserForm.

 

[quyenpv]

Tổng độ rộng 4 cột có bằng độ rộng của 4 cái textbox tiêu đề không bạn?
Rồi bạn có cdoe thiết lập lại listbox width không?
Cái Form của bạn có tự co giãn theo độ phân giải màn hình không?
Ngồi đoán mò mệt quá.

Dạ file của anh hay file của em cũng bị. Khi em thiết lập như trên thì khi tìm kiếm bị hiện tượng co listbox lại ạ
1. Ban đầu khi load form

2. Khi tìm kiếm


Khi áp dụng Code của anh vào file của em thì nó co lại rõ rệt anh

 

[ongke0711]

Dạ file của anh hay file của em cũng bị. Khi em thiết lập như trên thì khi tìm kiếm bị hiện tượng co listbox lại ạ
1. Ban đầu khi load form

2. Khi tìm kiếm


Khi áp dụng Code của anh vào file của em thì nó co lại rõ rệt anh

Đúng là file này bị cái bệnh như bạn nói. Khi gõ chuỗi tìm kiếm mà nó tìm không ra giá trị thì cái listbox nó co lại, nếu gõ tiếp thì nó co tiếp đến khi còn chừng 2 cột.
Chắc là do cái hàm find_range_multiCol() ở trên hoặc một cái lỗi (bug) của Excel . Để kiểm tra lại.



Trong khi đó thì bạn test thử file này xem.

 

[ongke0711]

Tôi nghĩ việc tự co lại chiều rộng Listbox trong Userform là một cái bug, nguyên nhân chính xác thì không rõ. Để xử lý tạm thì có thể tự gán lại Listbox.Width mỗi khi thao tác tìm kiếm.

Const LIST_WIDTH = 550

With Listbox
  .Width = LISTBOX_WIDTH
   ...
End With

 

[Ngày mai trời lại sáng]

Đúng là file này bị cái bệnh như bạn nói. Khi gõ chuỗi tìm kiếm mà nó tìm không ra giá trị thì cái listbox nó co lại, nếu gõ tiếp thì nó co tiếp đến khi còn chừng 2 cột.
Chắc là do cái hàm find_range_multiCol() ở trên hoặc một cái lỗi (bug) của Excel . Để kiểm tra lại.

View attachment 279306

Trong khi đó thì bạn test thử file này xem.

Lần trước em thử cũng bị lỗi này mà không biết nguyên nhân tại sao, rồi cũng làm tạm thời cách như bác là mỗi lần tìm kiếm lại chỉnh lại kích thước Listbox.

 

[befaint]

Tôi nghĩ việc tự co lại chiều rộng Listbox trong Userform là một cái bug

Do code sai đó anh, chứ không phải bug nào.

find_range_multiCol = Array("")


Chỉnh lại thế này là được.

Public Function find_range_multiCol(ByVal source_range As Range, ByVal string_find As String, _
                                    Optional ByVal list_col_format_number As String = "0", _
                                    Optional ByVal type_format As String = "#,##0")
    Dim numCols As Long
    Dim arr() As Variant, max_row As Long, max_col As Long, i As Long, j As Long, k As Long
    Dim result() As Variant, item_arr As Variant, kk As Long, flag_format As Boolean, list_col, icol
   
    numCols = source_range.Columns.Count
   
    If source_range.Count = 1 Then
        find_range_multiCol = Array(source_range.Value2)
        Exit Function    '// khong xet source_range chi co 1 cell'
    End If
    arr = source_range.Value2   '// chep range vao mang arr'
    max_row = UBound(arr, 1)
    max_col = UBound(arr, 2)
    ReDim result(1 To max_col, 1 To max_row)    '// khai bao kich thuoc mang result, xoay 90 do so voi mang arr'
    string_find = VBA.UCase(string_find)
    If list_col_format_number <> "0" Then
        flag_format = True
        list_col_format_number = Replace(list_col_format_number, " ", "")
        list_col = Split(list_col_format_number, ",")
    End If
    If Len(string_find) > 0 Then
        string_find = "*" & string_find & "*"
        For i = 1 To max_row
            For k = 1 To max_col
                item_arr = VBA.UCase(arr(i, k))
                If item_arr Like string_find Then    'neu tim thay'
                    j = j + 1
                    For kk = 1 To max_col
                        result(kk, j) = arr(i, kk)
                        If flag_format = True Then  ' ding dang '
                            For Each icol In list_col
                                If icol >= 1 And icol <= max_col Then
                                    result(icol, j) = Format(Val(arr(i, icol)), type_format)
                                End If
                            Next icol
                        End If
                    Next kk
                    Exit For    'thoat tim '
                End If
            Next k
        Next i
        If j Then
            ReDim Preserve result(1 To max_col, 1 To j)
            ' xoay mang result'
            find_range_multiCol = transpose_array(result)
        Else
            Dim emptyArray As Variant
            ReDim emptyArray(1 To 1, 1 To numCols)
            find_range_multiCol = emptyArray
        End If
    Else
        'Tra ve mang goc nhung van dinh dang cot
        If flag_format = True Then  ' ding dang '
            For Each icol In list_col
                If icol >= 1 And icol <= max_col Then
                    For i = 1 To max_row
                        arr(i, icol) = Format(Val(arr(i, icol)), type_format)
                    Next i
                End If
            Next icol
        End If
        find_range_multiCol = arr

    End If
End Function

 

[teddytran1212]

Mấy bác cho em hỏi, có cách nào trong Box tìm kiếm em Copy được tên hàng hoặc mã hàng ko ạ