ongke0711
Thành viên gắn bó
- Tham gia
- 7/9/06
- Bài viết
- 1,954
- Được thích
- 2,534
- Giới tính
- Nam
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:
- Hàm faytLstBxMultiCol():
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
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() :
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
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)
. 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:
Mã:
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():
Mã:
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() :
Mã:
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)
Lần chỉnh sửa cuối:
