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)

 

[ongke0711]

Em cám ơn anh đã hỗ trợ.
-Em đã làm được dữ liệu được gán vào ListBox nhưng khi gõ ký tự ở TextBox thì nó không hoạt động
-Trường hợp em muốn tìm kiếm theo sheet chỉ định thì phải làm thế nào ạ.
Rất mong anh hỗ trợ thêm do file này của công ty nên em không thể đính kèm lên diễn đàn được

Bạn vô mục Conversation (có icon hình lá thư kế bên nick của bạn) trao đổi cho tiện. Trao đổi trường hợp riêng nhiều quá loãng để tài.

 

[ngoctinh87]

Bạn vô mục Conversation (có icon hình lá thư kế bên nick của bạn) trao đổi cho tiện. Trao đổi trường hợp riêng nhiều quá loãng để tài.

Em chưa hiếu ý anh lắm
Nếu em làm 1 file có 1 sheet thì hoạt động bình thường
Nhưng khi em làm vào file thực tế nhiều sheet thì gõ ký tự ở Textbox nó không hoạt động

 

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

Bạn nên cho ví dụ 1 trường hợp cụ thể, thực tế gần sát với thao tác xử lý với form tìm kiếm này để dễ hình dung và có cái nhìn tổng thể mới dễ xử lý hơn vì nó còn liên quan nhiều thứ bẫy lỗi dữ liệu, qui trình, luồng xử lý thao tác trên Form ...
Chẳng hạn như tôi thường dùng Form này như 1 form danh sách (ds khách hàng, ds phiếu nhập, xuất ...), sau khi tìm kiếm sẽ click chọn record tìm thấy -> mở form chi tiết tương ứng record đó để chỉnh sửa.
Nếu có file dữ liệu mẫu thực tế nào đó tốt, khỏi mất công tự tạo để test

Xin chào anh @ongke0711 & tất cả mọi người.
Nhờ mọi người xem & giúp đỡ OT vấn đề trong sheet "Nhap lieu" với ạ.

 

[ongke0711]

Xin chào anh @ongke0711 & tất cả mọi người.
Nhờ mọi người xem & giúp đỡ OT vấn đề trong sheet "Nhap lieu" với ạ.

Trường hợp này của bạn thì nên xử lý như sau:
- Đổi source của Listbox frmSearch: lấy từ dữ liệu từ sheet muốn tìm kiếm (Sheet "NhapLieu").
- Dùng sự kiện "Worksheet_BeforeDoubleClick".
- Dùng Range.Find để tìm Cell chưa dữ liệu tìm được.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Application.Intersect(Target, Range("C:C")) Is Nothing Then
        Cancel = True
        frmSearch.Show
    Else
        'Exit Sub - do nothing
    End If
End Sub

Sub Find_First(sFindString As Variant, sSheetName As String, sFindRng As String)
    Dim Rng As Range
    If Trim(sFindString) <> "" Then
        With Sheets(sSheetName).Range(sFindRng)
            Set Rng = .Find(What:=sFindString, _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
            If Not Rng Is Nothing Then
                'Application.Goto Rng, True
                Rng.Select
            Else
                MsgBox "Không tìm thay."
            End If
        End With
    End If
End Sub

Code trên Userform:

Private Sub lstDanhSachVPP_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Dim vSearchedItem As Variant
    vSearchedItem = Me.lstDanhSachVPP.Column(2, Me.lstDanhSachVPP.ListIndex)
    Call Find_First(vSearchedItem, "NhapLieu", "C:C")
End Sub

 

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

Trường hợp này của bạn thì nên xử lý như sau:
- Đổi source của Listbox frmSearch: lấy từ dữ liệu từ sheet muốn tìm kiếm (Sheet "NhapLieu").
- Dùng sự kiện "Worksheet_BeforeDoubleClick".
- Dùng Range.Find để tìm Cell chưa dữ liệu tìm được.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Application.Intersect(Target, Range("C:C")) Is Nothing Then
        Cancel = True
        frmSearch.Show
    Else
        'Exit Sub - do nothing
    End If
End Sub

Sub Find_First(sFindString As Variant, sSheetName As String, sFindRng As String)
    Dim Rng As Range
    If Trim(sFindString) <> "" Then
        With Sheets(sSheetName).Range(sFindRng)
            Set Rng = .Find(What:=sFindString, _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
            If Not Rng Is Nothing Then
                'Application.Goto Rng, True
                Rng.Select
            Else
                MsgBox "Không tìm thay."
            End If
        End With
    End If
End Sub

Code trên Userform:

Private Sub lstDanhSachVPP_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Dim vSearchedItem As Variant
    vSearchedItem = Me.lstDanhSachVPP.Column(2, Me.lstDanhSachVPP.ListIndex)
    Call Find_First(vSearchedItem, "NhapLieu", "C:C")
End Sub

Xin chào anh @ongke0711 ,
Cảm ơn anh đã giúp đỡ ạ, Dạ OT muốn lấy danh mục có sẵn từ một sheet đó là sheet dữ liệu mẫu của anh "tblDMSP" rồi nhập liệu vào sheet("nhập liệu") đó anh.
Chúc anh năm mới sức khỏe và thành công ạ.

 

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

Híc OT chờ mãi không thấy anh @ongke0711 , OT đã loay hoay suốt mấy ngày hôm nay,kết quả cũng có vẻ 'xương xương' (gần đạt được ý muốn),:
Code trong ThisWorkbook:

Private Sub Workbook_SheetBeforeDoubleClick(ByVal sh As Object, ByVal Target As Range, Cancel As Boolean)
    
'    On Error GoTo End_Error
    
    If Target.CountLarge > 1 Then Exit Sub
    
    If sh.Name = "Nhap lieu" Then
        If Not Intersect(sh.Range(rHOATDONG), Target) Is Nothing And Target.Count = 1 Then
            If ActiveCell.Value = Empty Then
                Call MoForm(sh)
                Cancel = True
            End If
        End If
    End If
    
    
End_Exit:
    Exit Sub
    
End_Error:
    MsgBox "Co loi xay ra trong qua trinh!", vbCritical, "Error"
    Resume End_Exit
    
End Sub

Code trong frmSearch:
Thêm đoạn:

Private Sub lstDanhSachVPP_Click()
    Dim sheet As Worksheet
    Set sheet = ThisWorkbook.Worksheets(shNhapLieu)
    If Not Intersect(sheet.Range(rHOATDONG), ActiveCell) Is Nothing Then
        With lstDanhSachVPP
            sheet.Cells(ActiveCell.Row, 2) = .List(.ListIndex, 2)
            sheet.Cells(ActiveCell.Row, 3) = .List(.ListIndex, 1)
        End With
    End If
End Sub

Sửa đoạn :

Sub ganSourceListbox()

    Dim sArr As Variant, sheet As Worksheet
    Set sheet = ThisWorkbook.Worksheets(shDanhMuc)
    
    Set oRngLstBx1 = sheet.Range(sheet.Range("A2"), sheet.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
    Call formatNumColumnLstBx("lstDanhSachVPP", "5,6", Me, "#,##0")

End Sub

Code trong Module:

Option Explicit

Public Const shNhapLieu As String = "Nhap lieu"
Public Const shDanhMuc As String = "tblDMSP"
Public Const rHOATDONG As String = "C2:C23"

Public Sub MoForm(sh As Worksheet)
    frmSearch.Show False
End Sub

Hehe ... nhìn code cũng thấy ghê gớm như người lớn

Nhờ anh @ongke0711 và mọi người "góp ý"(ra tay) thêm ạ.

 

[cristianoducvu]

Tham gia cải tiến code #1:

Option Explicit
Option Compare Text
Dim ArrayData, MaxRow&, MaxCol%, TempArr()
Private Sub txtChuoiTK_Change()
    Call faytLstBxMultiCol(Me.txtChuoiTK.Value, Me.lstDanhSachVPP)
End Sub
Private Sub UserForm_Initialize()
    call ganSourceListbox:Me.txtChuoiTK.SetFocus
End Sub
Private Sub ganSourceListbox()
    With Range("A2")
      MaxCol = .End(xlToRight).Column
      MaxRow = Cells(Rows.Count, .Column).End(xlUp).Row
      ArrayData = .Resize(MaxRow, MaxCol).Value
    End With
    ReDim TempArr(1 To MaxRow, 1 To MaxCol)
    Me.lstDanhSachVPP.List = ArrayData
End Sub
Private Sub faytLstBxMultiCol(strSearchTxt$, _
                                    ListBox As MSForms.ListBox)
    Dim i&, j%, r&
    For i = 1 To MaxRow
      For j = 1 To MaxCol: If ArrayData(i, j) Like "*" & strSearchTxt & "*" Then GoTo AddArr:Next
      If False Then
AddArr:  r = r + 1
        For j = 1 To MaxCol
            TempArr(r, j) = ArrayData(i, j)
            If j = 5 And TempArr(r, j) >= 1000 Then _
              TempArr(r, j) = Format(ArrayData(i, j), "#,##0")
        Next
      End If
    Next
    With ListBox
      .Clear: .AddItem
      If r = 0 Then GoTo EH_Exit
      ReDim result(1 To r, 1 To MaxCol)
      GoSub TranTempArr: .List = result
    End With
EH_Exit: Exit Function
TranTempArr:
  For i = 1 To r: For j = 1 To MaxCol: result(i, j) = TempArr(i, j): Next j, i
Return
End Sub

Private Sub UserForm_Terminate()
  On Error Resume Next
  Erase ArrayData: Erase TempArr
End Sub

OT kết hợp các Phương thức của ListBox: Selected , List , ListIndex , ...
Các sự kiện ListBox MouseDown / MouseUp
Ràng buộc các dữ liệu đã lấy trước đó, để tránh Duplicate.
Hoặc Remove ListIndex khi click chọn
Để chọn nhiều thì thuộc tính Multi Select thành True

Bác cho Em hỏi nếu em muốn tìm kiếm kép, tức là sau khi tìm kiếm dữ liệu được nhập trong textbox1 thì ta được 1 list, Em muốn tìm kiếm tiếp dữ liệu được nhập trong textbox2 trong list vừa được tìm ra để trả về kết quả chính xác hơn. Anh giải đáp giúp em. em cảm ơn

 

[Phụ Hồ Lên Phú Hộ]

Bác cho Em hỏi nếu em muốn tìm kiếm kép, tức là sau khi tìm kiếm dữ liệu được nhập trong textbox1 thì ta được 1 list, Em muốn tìm kiếm tiếp dữ liệu được nhập trong textbox2 trong list vừa được tìm ra để trả về kết quả chính xác hơn. Anh giải đáp giúp em. em cảm ơn

Thì bạn dùng sự kiện textbox2 change tìm trên list box hay tmparr

 

[cristianoducvu]

Thì bạn dùng sự kiện textbox2 change tìm trên list box hay tmparr

Em chưa hiểu ý của Anh ạ, Em mới nhập môn nên hàm và các thuật ngữ chưa nắm rõ được ạ, em thao khảo code của bác HeSanbi thì tìm chỉ được dữ liệu trong textbox 1 muốn lọc tiếp từ list vừa tìm được thì chưa biết làm như thế nào ạ

 

[Phụ Hồ Lên Phú Hộ]

Em chưa hiểu ý của Anh ạ, Em mới nhập môn nên hàm và các thuật ngữ chưa nắm rõ được ạ, em thao khảo code của bác HeSanbi thì tìm chỉ được dữ liệu trong textbox 1 muốn lọc tiếp từ list vừa tìm được thì chưa biết làm như thế nào ạ

Mình cũng mới nhập môn cũng có hiểu rõ đâu, bạn tham khảo code của bạn kia thì bạn ghi chú đoạn nào làm cái gì để nhớ khi txt 1 tìm thì nó hiện vào list box từ tmparr thì bạn muốn tìm từ txt 2 thì cứ tìm tiếp trong list box hoặc tmparr. Mình nghĩ là vậy chứ cũng có rành đâu kkkk

 

[cristianoducvu]

Mình cũng mới nhập môn cũng có hiểu rõ đâu, bạn tham khảo code của bạn kia thì bạn ghi chú đoạn nào làm cái gì để nhớ khi txt 1 tìm thì nó hiện vào list box từ tmparr thì bạn muốn tìm từ txt 2 thì cứ tìm tiếp trong list box hoặc tmparr. Mình nghĩ là vậy chứ cũng có rành đâu kkkk

))))))) em cũng thử mấy chục cách bữa giờ r mà k đc :3

 

[cristianoducvu]

Mình cũng mới nhập môn cũng có hiểu rõ đâu, bạn tham khảo code của bạn kia thì bạn ghi chú đoạn nào làm cái gì để nhớ khi txt 1 tìm thì nó hiện vào list box từ tmparr thì bạn muốn tìm từ txt 2 thì cứ tìm tiếp trong list box hoặc tmparr. Mình nghĩ là vậy chứ cũng có rành đâu kkkk

He he vừa nói xong mò ra được luôn bác ạ kaka

 

[Phụ Hồ Lên Phú Hộ]

He he vừa nói xong mò ra được luôn bác ạ kaka

Vậy là bạn giỏi quá rồi, chúc mừng nhé

 

[NghiaKieu]

@ongke0711 Không biết có thể phát triển lên thành tìm kiếm theo nhiều điều kiện không ạ? Các điều kiện các nhau bằng dấu phẩy chằng hạn.

 

[SA_DQ]

. . . . Không biết có thể phát triển lên thành tìm kiếm theo nhiều điều kiện không ạ? Các điều kiện các nhau bằng dấu phẩy chằng hạn.

Bạn nên cho 1 hay vài ví dụ trực quan hơn xem sao.

 

[NghiaKieu]

Bạn nên cho 1 hay vài ví dụ trực quan hơn xem sao.

Dạ ý em là như ví dụ sau nhập vào textbox "băng, mặt" thì nó lọc theo 2 điều kiện "băng" và "mặt" ạ. Em nghĩ chắc phải đưa list kết quả tra theo từ "băng" vào mảng tạm rồi mới lọc tìm tiếp từ "mặt" trong mảng tạm đấy chắc mới được.

 

[befaint]

"băng" và "mặt"

Vậy người ta gõ từ khóa là: băng*mặt
chứ ai lại đi gõ băng phẩy mặt.
Mình quên kỹ thuật gõ từ khóa tìm kiếm rồi à?

 

[NghiaKieu]

Vậy người ta gõ từ khóa là: băng*mặt
chứ ai lại đi gõ băng phẩy mặt.
Mình quên kỹ thuật gõ từ khóa tìm kiếm rồi à?

Cảm ơn bác nhiều!

 

[buctoc147]

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)


View attachment 218600

Tư duy chưa thông minh cho lắm. Vẫn còn lỗi phân biệt Hoa Thường và tiếng việt có dấu không dấu. gõ từ "bang" phải có luôn "băng keo ....." chứ
Nói chung nếu phải tìm kiếm y như Tìm kiếm danh bạ trong Iphone thì ok. Vì tôi từng làm cho ios được 3 năm

Gõ từ " ao phao" cũng không thấy


Nếu dữ liệu trống trống thì báo lỗi. Chứng tỏ rất ẩu. kiểu như xe ô tô không đạp phanh để máy vẫn nổ . có Mercedes-Benz chưa em trai. nhìn cái xe Đức người ta tư duy kìa. học hỏi nhiều vào


nếu có 1 dòng có dữ liệu thì Lỗi. Tức là file này chỉ tìm kiếm từ dòng thứ 2



tác giả quá ẩu .không test kỷ càng trong phòng thì nghiệm.
Nói chung file trên tôi cho 1.5 điểm. Cần ôn thi lại . Nếu làm công ty tôi tôi đuổi việc ngay. Vì tội cẩu thả. Đã làm thì làm cho đàng hoàng. còn không làm thì thôi. làm vậy mà đòi chia sẽ. Xóa đi em . Mong em đừng buồn khi anh phản biện . Vì có vậy mới tiến bộ được.

 

[befaint]

Tư duy chưa thông minh cho lắm.

Anh @ongke0711 , anh đã làm gì mà ra nông nỗi vậy?

Anh vào chỉnh code lại đi nha.