Demo Form tìm kiếm nhiều cột trong Listbox (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

ongke0711

Thành viên gắn bó
Tham gia
7/9/06
Bài viết
2,340
Được thích
3,167
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:

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)


218600
 

File đính kèm

Lần chỉnh sửa cuối:
Anh có thấy add nguyên arr vào no lẹ hon add từng item hông, tại sao?.
Số là số còn dấu phân cach la do truoc khi anh add anh chuyen qua string thôi, theo em nghĩ là vậy hihi.
 
Upvote 0
Anh có thấy add nguyên arr vào no lẹ hon add từng item hông, tại sao?.
Số là số còn dấu phân cach la do truoc khi anh add anh chuyen qua string thôi, theo em nghĩ là vậy hihi.

:) đúng rồi em, cập nhật nguyên gói một lúc bao giờ cũng nhanh hơn dùng vòng lặp thêm từng item (bên Access thì nó dùng Recordset thay cho Array). Tuỳ vào nguồn dữ liệu đầu vào mà mình chọn kiểu nào tốt nhất cho nó. Còn vụ định dạng số, ý anh nói là cách nó hiển thị trong listbox sau khi đổ xuống từ mảng, nó không còn hiển thị dạng "#,00" hoặc "Standard". Vd: nó hiển thị 60000 chứ không hiển thị 60,000 cho dễ nhìn.
 
Upvote 0
:) đúng rồi em, cập nhật nguyên gói một lúc bao giờ cũng nhanh hơn dùng vòng lặp thêm từng item (bên Access thì nó dùng Recordset thay cho Array). Tuỳ vào nguồn dữ liệu đầu vào mà mình chọn kiểu nào tốt nhất cho nó. Còn vụ định dạng số, ý anh nói là cách nó hiển thị trong listbox sau khi đổ xuống từ mảng, nó không còn hiển thị dạng "#,00" hoặc "Standard". Vd: nó hiển thị 60000 chứ không hiển thị 60,000 cho dễ nhìn.
Vì trong mãng nó la 60000 chu khong phai 60,000 nếu vậy anh phải format nó thôi
 
Upvote 0
Ah mà lâu lắm rồi em có Dowload được 1 cái Control list rất đẹp bên Diễn đàn VB về em có Desight lại nhúng vào Excel, tốc độ load dữ so với Listbox 9/10 đó anh, giao diện thì rất đẹp, đẹp hơn ListView luôn. mà em mất Soure rồi. anh thử vô đó tìm xem
 
Upvote 0
Vì trong mãng nó la 60000 chu khong phai 60,000 nếu vậy anh phải format nó thôi

Mới cập nhật thêm cái hàm format kiểu số cho các cột tuỳ chọn trong listbox.
Anh cũng tìm thấy cái class canh lề trái phải cột trong listbox nhưng chạy không nhanh nên không đưa lên đây.
Về cái Listview control thì anh tìm chưa ra. :)
 
Lần chỉnh sửa cuối:
Upvote 0
giỏi quá, anh thử rút gọn nữa thử xem được hông
 
Upvote 0
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:

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


View attachment 218600

Cảm ơn bạn nhiều,
Ứng dụng này rất thiết thực trong thực tế.
Bạn có thể mở rộng thêm tính năng nhập liệu nữa được không ạ (nghĩa là khi kích vào dòng nào sẽ nhập liệu dòng đó xuống bảng tính)?
 
Upvote 0
Ứng dụng này rất thiết thực trong thực tế.
Bạn có thể mở rộng thêm tính năng nhập liệu nữa được không ạ (nghĩa là khi kích vào dòng nào sẽ nhập liệu dòng đó xuống bảng tính)?
Nếu không thông qua 1 bước đệm, thì chả mấy chốc CSDL thành đống rác, không hơn không kém!
 
Upvote 0
Cảm ơn bạn nhiều,
Ứng dụng này rất thiết thực trong thực tế.
Bạn có thể mở rộng thêm tính năng nhập liệu nữa được không ạ (nghĩa là khi kích vào dòng nào sẽ nhập liệu dòng đó xuống bảng tính)?

:) 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 :)
 
Upvote 0
Hông biết mình tìm trên range hay trên mảng cái nào lẹ hơn vậy anh ??
 
Upvote 0
Hông biết mình tìm trên range hay trên mảng cái nào lẹ hơn vậy anh ??

Theo như thông tin anh đã đọc trước đây thì tìm kiếm trên mảng nhanh hơn nhiều so với tìm trên range.
Có một kỹ thuật được khuyên là nếu giảm được tương tác giữa Worksheet với VBA thì nên giảm để tăng hiệu quả xử lý. Do đó việc load toàn bộ range lên mảng, ngắt kết nối với worksheet, thực hiện tính toán, xử lý trên mảng xong rồi gán một cục xuống worksheet sẽ nhanh hơn rất nhiều so với việc tương tác liên tục giữa worksheet (cell), biến và VBA.
Còn muốn thực tế thì phải chịu khó viết code test thử với số dòng tương đối lớn để xem như thế nào.
Các anh em có kinh nghiệm gì khác thì chia sẻ để học hỏi thêm nhé.

Link tham khảo: https://fastexcel.wordpress.com/2011/10/26/match-vs-find-vs-variant-array-vba-performance-shootout/
 
Lần chỉnh sửa cuối:
Upvote 0
Theo như thông tin anh đã đọc trước đây thì tìm kiếm trên mảng nhanh hơn nhiều so với tìm trên range.
Có một kỹ thuật được khuyên là nếu giảm được tương tác giữa Worksheet với VBA thì nên giảm để tăng hiệu quả xử lý. Do đó việc load toàn bộ range lên mảng, ngắt kết nối với worksheet, thực hiện tính toán, xử lý trên mảng xong rồi gán một cục xuống worksheet sẽ nhanh hơn rất nhiều so với việc tương tác liên tục giữa worksheet (cell), biến và VBA.
Còn muốn thực tế thì phải chịu khó viết code test thử với số dòng tương đối lớn để xem như thế nào.
Các anh em có kinh nghiệm gì khác thì chia sẻ để học hỏi thêm nhé.

Link tham khảo: https://fastexcel.wordpress.com/2011/10/26/match-vs-find-vs-variant-array-vba-performance-shootout/
Vậy sao anh không tìm thẳng trên arr toàn cục và check column number format luôn mà làm chi cho nó ngoằn ngoèo vậy. Cái này em nghĩ dữ liệu nhiều nó chậm áh
 
Upvote 0
Vậy sao anh không tìm thẳng trên arr toàn cục và check column number format luôn mà làm chi cho nó ngoằn ngoèo vậy. Cái này em nghĩ dữ liệu nhiều nó chậm áh

Trình Array chưa tới nên a đang ngâm cứu vụ format trong mảng... :). Nếu đã làm qua em demo cho anh học hỏi nhé (cho nhanh).
Nếu viết được cái hàm định dạng luôn trong mảng sẽ hỗ trợ nhiều vì nhiều trường hợp đưa dữ liệu lên mảng xong đổ xuống mất định dạng. vd: số điện thoại dạng text có 1 số '0' đầu sau khi đưa lên mảng gán xuống nó mất số '0'.
 
Lần chỉnh sửa cuối:
Upvote 0
Trình Array chưa tới nên a đang ngâm cứu vụ format trong mảng... :). Nếu đã làm qua em demo cho anh học hỏi nhé (cho nhanh).
Nếu viết được cái hàm định dạng luôn trong mảng sẽ hỗ trợ nhiều vì nhiều trường hợp đưa dữ liệu lên mảng xong đổ xuống mất định dạng. vd: số điện thoại dạng text có 1 số '0' đầu sau khi đưa lên mảng gán xuống nó mất số '0'.
Mạnh lâu nay bận quá chỉ ngó qua chút ko có thời gian mò code
Bạn tham khảo link sau bài #15 xem sao nha... thử gán cái mảng đó vào bộ nhớ xong gán lại Sheet xem !!!

 
Upvote 0
Mạnh lâu nay bận quá chỉ ngó qua chút ko có thời gian mò code
Bạn tham khảo link sau bài #15 xem sao nha... thử gán cái mảng đó vào bộ nhớ xong gán lại Sheet xem !!!


:) Bạn mạnh chắc thích nhạc Sơn Tùng bài "Em đi xa quá...".
Tôi muốn học hỏi cách viết hàm hoặc chèn code để tuỳ chọn định dạng cột nào muốn trong mảng trước khi đổ dữ liệu xuống Excel sheet để cái kỹ thuật tìm kiếm này chạy tốt hơn.
 
Upvote 0
:) Bạn mạnh chắc thích nhạc Sơn Tùng bài "Em đi xa quá...".
Tôi muốn học hỏi cách viết hàm hoặc chèn code để tuỳ chọn định dạng cột nào muốn trong mảng trước khi đổ dữ liệu xuống Excel sheet để cái kỹ thuật tìm kiếm này chạy tốt hơn.
Mạnh thích cái Hàm này : faytLstBxMultiCol

Nếu có thời gian mạnh sẻ dựa trên code đó viết lại:

1/ bỏ hàm ( Transpose ) sArr = Application.WorksheetFunction.Transpose(sArr)
sẻ viết thêm 1 hàm chuyển mảng vô đó nó sẻ cho tốc độ nhanh hơn Hàm Transpose một chút đấy

2/ sẻ viết lại 1 hàm chung nhất có thể xài trên Cells hay textbox trên Sheet khi ta gõ vào đó

3/ khi lọc xong kết quả có thể gán xuống sheet hay ở đâu đó do mình gán
.... ý tưởng vậy mà cũng chưa biết khi nào rảnh mà quậy nữa ===\. -0-0-0-
 
Upvote 0
Anh chạy thử xem nhé. Em chạy thử 20 nghìn dòng thấy sự khác biệt rõ ràng..

Hàm tìm trên array
PHP:
Option Explicit

Public Function find_range_multiCol(ByVal source_range As Range, ByVal string_find As String)
    ''
    ' source_range: vung du lieu goc    '
    ' string_find: chuoi can tim        '
    ' ket qua tra ve mang cac phan tu tim duoc theo string_find.    '
    ''
    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
    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 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)
                    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
            find_range_multiCol = Array("")
        End If
    Else
        find_range_multiCol = arr
    End If
End Function

Public Function transpose_array(ByVal source_array As Variant)
    ' source_array: mang 2 chieu '
    ' xoay mang source_array 90 do '
    Dim arr As Variant, max_row As Long, max_col As Long, result(), i As Long, j As Long
    arr = source_array
    max_row = UBound(arr, 1)
    max_col = UBound(arr, 2)
    ReDim result(1 To max_col, 1 To max_row)
    For i = 1 To max_row
        For j = 1 To max_col
            result(j, i) = arr(i, j)
        Next j
    Next i
    transpose_array = result
End Function
Code cho sự kiện tìm
PHP:
Private Sub txtChuoiTK_Change()
    Dim strTextSearch As String
    strTextSearch = Me.txtChuoiTK.Value
    'Call faytLstBxMultiCol(oRngLstBx1, strTextSearch, "lstDanhSachVPP", frmSearch)

    Me.lstDanhSachVPP.List = find_range_multiCol(oRngLstBx1, strTextSearch)
End Sub
 
Upvote 0
định dạng luôn trong mảng
Anh xem thử nhé..
PHP:
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")
    ''
    ' source_range: vung du lieu goc    '
    ' string_find: chuoi can tim        '
    ' list_col_format_number: danh sach cac cot can dinh dang "2,3,4" '
    ' type_format: kieu dinh dang, mac dinh "#,##0" '
    ' ket qua tra ve mang cac phan tu tim duoc theo string_find.    '
    ''
    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
    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
            find_range_multiCol = Array("")
        End If
    Else
        find_range_multiCol = arr
    End If
End Function
Mã:
Private Sub txtChuoiTK_Change()
    Dim strTextSearch As String
    strTextSearch = Me.txtChuoiTK.Value
    'Call faytLstBxMultiCol(oRngLstBx1, strTextSearch, "lstDanhSachVPP", frmSearch)

    Me.lstDanhSachVPP.List = find_range_multiCol(oRngLstBx1, strTextSearch, "5")
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Hi cả nhà,
Cũng bài toán trên nhưng mình không muốn listbox lấy nguyên 1 mảng full Data
-> Chỉ lấy trường "Tên Sản Phẩm" và "Đơn Giá" đưa lên Listbox
Xin được thỉnh giáo các cao nhân
 
Lần chỉnh sửa cuối:
Upvote 0
Anh chạy thử xem nhé. Em chạy thử 20 nghìn dòng thấy sự khác biệt rõ ràng..

Hàm tìm trên array
PHP:
Option Explicit

Public Function find_range_multiCol(ByVal source_range As Range, ByVal string_find As String)
    ''
    ' source_range: vung du lieu goc    '
    ' string_find: chuoi can tim        '
    ' ket qua tra ve mang cac phan tu tim duoc theo string_find.    '
    ''
    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
    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 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)
                    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
            find_range_multiCol = Array("")
        End If
    Else
        find_range_multiCol = arr
    End If
End Function

Public Function transpose_array(ByVal source_array As Variant)
    ' source_array: mang 2 chieu '
    ' xoay mang source_array 90 do '
    Dim arr As Variant, max_row As Long, max_col As Long, result(), i As Long, j As Long
    arr = source_array
    max_row = UBound(arr, 1)
    max_col = UBound(arr, 2)
    ReDim result(1 To max_col, 1 To max_row)
    For i = 1 To max_row
        For j = 1 To max_col
            result(j, i) = arr(i, j)
        Next j
    Next i
    transpose_array = result
End Function
Code cho sự kiện tìm
PHP:
Private Sub txtChuoiTK_Change()
    Dim strTextSearch As String
    strTextSearch = Me.txtChuoiTK.Value
    'Call faytLstBxMultiCol(oRngLstBx1, strTextSearch, "lstDanhSachVPP", frmSearch)

    Me.lstDanhSachVPP.List = find_range_multiCol(oRngLstBx1, strTextSearch)
End Sub
Mạnh có cảm giác là xài Hàm InStr của bài 1 nó sẻ lọc ra chính xác hơn toán Tử Like hay sao ý ???!!!
 
Upvote 0
Anh xem thử nhé..

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")
...

Tuyệt vời bạn befaint.
Tôi mới test trên dữ liệu 500k dòng, 14 cột (52M). Chỉ có dùng Array mới tải dữ liệu lên là gán xuống listbox được còn cái cách của tôi và dùng ADO nó cũng đơ luôn.
- Qua đây tôi cũng phát hiện là ADO sẽ báo lỗi không tìm thấy cái named range (500k dòng), nếu giảm xuống 65k dòng thì ADO mới thấy Named range mà xử lý (máy dùng Excel 2013, dùng ADO trong Access với 500k dòng thì không gặp lỗi trên). Chẳng lẻ dùng ADO + Named range trong Excel có bị giới hạn? chưa hiểu được vụ này hoặc do tôi code sai cái gì đó. Tôi có đính kèm cái file dữ liệu 500k dòng để mọi người kiểm tra.
- Cũng nói thêm là trong thực tế theo tôi biết sẽ ít khi phải xử lý dữ liệu mấy trăm ngàn dòng trên ứng dụng Font End (FE) nên viêc dùng ADO recordset ở đây không chạy không có nghĩa là nó dở hơn Array nhé các bạn mà tuỳ trường hợp xử lý mà dùng thôi. ADO recordset nó có thế mạnh trong việc thêm, xoá dòng ...mà không cần phải redim, sắp xếp lại bộ nhớ như dùng Mảng (ADO tự xử). Việc lọc, sắp xếp dữ liệu cũng đươc hỗ trợ code xử lý nhanh hơn, ít phức tạp hơn Mảng.

- Link file dữ liệu mẫu dùng Worksheet + Mảng + ADO: SampleData(500k).xlsm
Bài đã được tự động gộp:

Hi cả nhà,
Cũng bài toán trên nhưng mình không muốn listbox lấy nguyên 1 mảng full Data
-> Chỉ lấy trường "Tên Sản Phẩm" và "Đơn Giá" đưa lên Listbox
Xin được thỉnh giáo các cao nhân

Cột nào bạn không muốn hiển thị thì thiết lập độ rộng cột đó = 0 pt trong danh sách Column Widths.
 
Lần chỉnh sửa cuối:
Upvote 0
Mạnh có cảm giác là xài Hàm InStr của bài 1 nó sẻ lọc ra chính xác hơn toán Tử Like hay sao ý ???!!!
Chỗ "chính xác hơn" em chưa hiểu ý anh lắm :(

Trường hợp xử lý nhiều dữ liệu (nhiều lần tìm kiếm) hình như dùng Like phù hợp hơn InStr đó anh..

không muốn hiển thị thì thiết lập độ rộng cột đó = 0 pt trong danh sách Column Widths.
Theo em dồn những cột nào cần lấy vào gần nhau trên bảng tính rồi gán vào là được. Nếu vẫn lấy như anh mà thiết lập 0pt thì vẫn tìm cột đó => kết quả tìm có thể không khớp với từ khóa đã nhập.
 
Upvote 0
Tuyệt vời bạn befaint.
Tôi mới test trên dữ liệu 500k dòng, 14 cột (52M). Chỉ có dùng Array mới tải dữ liệu lên là gán xuống listbox được còn cái cách của tôi và dùng ADO nó cũng đơ luôn.
- Qua đây tôi cũng phát hiện là ADO sẽ báo lỗi không tìm thấy cái named range (500k dòng), nếu giảm xuống 65k dòng thì ADO mới thấy Named range mà xử lý (máy dùng Excel 2013, dùng ADO trong Access với 500k dòng thì không gặp lỗi trên). Chẳng lẻ dùng ADO + Named range trong Excel có bị giới hạn? chưa hiểu được vụ này hoặc do tôi code sai cái gì đó. Tôi có đính kèm cái file dữ liệu 500k dòng để mọi người kiểm tra.
- Cũng nói thêm là trong thực tế theo tôi biết sẽ ít khi phải xử lý dữ liệu mấy trăm ngàn dòng trên ứng dụng Font End (FE) nên viêc dùng ADO recordset ở đây không chạy không có nghĩa là nó dở hơn Array nhé các bạn mà tuỳ trường hợp xử lý mà dùng thôi. ADO recordset nó có thế mạnh trong việc thêm, xoá dòng ...mà không cần phải redim, sắp xếp lại bộ nhớ như dùng Mảng (ADO tự xử). Việc lọc, sắp xếp dữ liệu cũng đươc hỗ trợ code xử lý nhanh hơn, ít phức tạp hơn Mảng.

- Link file dữ liệu mẫu dùng Worksheet + Mảng + ADO: SampleData(500k).xlsm
Bài đã được tự động gộp:



Cột nào bạn không muốn hiển thị thì thiết lập độ rộng cột đó = 0 pt trong danh sách Column Widths.
Cái này chưa chắc ADO đơ hơn Arr nha anh hihih
 
Upvote 0
Hi cả nhà,
Cũng bài toán trên nhưng mình không muốn listbox lấy nguyên 1 mảng full Data
-> Chỉ lấy trường "Tên Sản Phẩm" và "Đơn Giá" đưa lên Listbox
Xin được thỉnh giáo các cao nhân

Quên là trường hợp này bạn có thể dùng ADO để lấy cột dữ liệu nào muốn cũng dễ hơn.
"Select Ten, Gia From [Range]"
Bạn xem bài của bác HLMT:https://www.giaiphapexcel.com/diend...ile-không-mở-kết-nối-adodb-connection.141551/
 
Upvote 0
Mạnh có cảm giác là xài Hàm InStr của bài 1 nó sẻ lọc ra chính xác hơn toán Tử Like hay sao ý ???!!!

Chỗ "chính xác hơn" em chưa hiểu ý anh lắm :(

Trường hợp xử lý nhiều dữ liệu (nhiều lần tìm kiếm) hình như dùng Like phù hợp hơn InStr đó anh..

Tôi thấy ở trường hợp này InStr và Like *#* đều có tác dụng như nhau và tốc độ cũng như nhau thôi chứ không thể nói là 'chính xác' ở đây. Mà để nói đến tốc độ thì chắc phải thử nghiệm và xét thêm tới cái cách mà mỗi hàm thực hiện việc tìm kiếm.
 
Upvote 0
Quên là trường hợp này bạn có thể dùng ADO để lấy cột dữ liệu nào muốn cũng dễ hơn.
"Select Ten, Gia From [Range]"
Bạn xem bài của bác HLMT:https://www.giaiphapexcel.com/diend...ile-không-mở-kết-nối-adodb-connection.141551/
Tks huynh đài , đoạn này:

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

=> Bạn có thể edit lại phần này có thể dùng .list (..,..) = sArr (I,..) để lấy cột trong mảng lên listbox được không?
=> Mong bạn hỗ trợ thêm để mình tham khảo và có thể áp dụng được trong các trường hợp tùy biến data từ mảng lên listbox
(Mình đính kèm lại File của chính bạn để dễ hình dung)
 

File đính kèm

Upvote 0
Tôi thấy ở trường hợp này InStr và Like *#* đều có tác dụng như nhau và tốc độ cũng như nhau thôi chứ không thể nói là 'chính xác' ở đây. Mà để nói đến tốc độ thì chắc phải thử nghiệm và xét thêm tới cái cách mà mỗi hàm thực hiện việc tìm kiếm.
Mạnh ko nói tới tốc độ mà trước đây Mạnh có mấy lần cũng suy nghĩ nên dùng toán tử Like hay InStr .... còn "Chính xác" như thế nào Mạnh thấy trong VBLibrary nó có mô ta 2 cái hàm đó như sau:

Tên hàm:
InStr

Mô tả:
InStr([start, ]string1, string2[, compare])
Tìm chuỗi string2 trong chuỗi string1, tìm từ vị trí start

Tham số:
start
Vị trí tìm
string1
Chuỗi tìm kiếm
string2
Giá trị cần tìm
compare
Chỉ rõ kiểu dữ liệu để so sánh trong quá trình tìm kiếm

Ghi chú:
Dùng cho tham số compare
vbUseCompareOption = –1
Chế độ tùy chọn, VB sẽ tự động lựa lọai dữ liệu thích hợp
vbBinaryCompare = 0
So sánh nhị phân
vbTextCompare = 1
So sánh chuỗi
vbDatabaseCompare = 2
So sánh dữ liệu

Ví dụ:
Mã:
Option Explicit
Private Sub Form_Load()
Dim SearchString, SearchChar, MyPos
    SearchString = "XXpXXpXXPXXP"' String to search in.
    SearchChar = "P"' Search for "P".
' So sanh theo cua text tu vi tri 4
    MyPos = InStr(4, SearchString, SearchChar, 1)' Returns 6.
' So sanh theo Binary
    MyPos = InStr(1, SearchString, SearchChar, 0)' Returns 9.
' So sanh theo Binary, do mac dinh la 0
    MyPos = InStr(SearchString, SearchChar)' Returns 9.
    MyPos = InStr(1, SearchString, "W")' Returns 0.
End Sub

Tên hàm:

Like

Mô tả:
"String1" Like "String2"
So sánh 2 chuỗi cho phép sử dụng biệt ngữ (như dùng ký tự đại diện trong Dos) trị trả về = True nếu tương hợp.

Tham số:
String1, String2: là hai chuỗi ký tự cần so sánh.

Ghi chú:
Hàm Like mặc định cũng là hàm nhạy ký tự, theo thiết lập Option Compare ở form hoặc module

Ví dụ:
Mã:
"abcd" Like "*bcd" = True
"abcd" Like "a?cd" = True
"a1cd" Like "a#cd" = True

Áp dụng cho bài thớt này cứ thử gõ một cái chuỗi nào đó xong xem nó trả về cái gì là biết .... thử các kiểu đi sẻ thấy ....
 
Upvote 0
Mạnh ko nói tới tốc độ mà trước đây Mạnh có mấy lần cũng suy nghĩ nên dùng toán tử Like hay InStr .... còn "Chính xác" như thế nào Mạnh thấy trong VBLibrary nó có mô ta 2 cái hàm đó như sau:

....
Ghi chú:
Dùng cho tham số compare
vbUseCompareOption = –1
Chế độ tùy chọn, VB sẽ tự động lựa lọai dữ liệu thích hợp
vbBinaryCompare = 0
So sánh nhị phân
vbTextCompare = 1
So sánh chuỗi
vbDatabaseCompare = 2
So sánh dữ liệu

................
Ghi chú:
Hàm Like mặc định cũng là hàm nhạy ký tự, theo thiết lập Option Compare ở form hoặc module


Áp dụng cho bài thớt này cứ thử gõ một cái chuỗi nào đó xong xem nó trả về cái gì là biết .... thử các kiểu đi sẻ thấy ....

Vấn đề trên dễ hiểu mà bạn. Việc dùng InStr hay Like còn tuỳ thuộc ý đồ tìm kiếm của bạn thôi.
Đối với ví dụ của tôi, gọi là "tìm kiếm ngay khi gõ" tức là chưa có một chuỗi "chính xác" cần tìm. Vd: gõ chữ "o" là tìm ngay khác với việc chờ gõ đầy đủ chữ "ongke0711" rồi mới tìm Full text. Do đó trong ví dụ của tôi thì dùng InStr hay Like mức độ chính xác như nhau. Hơn nữa bạn xem kỹ sẽ thấy befaint khi dùng Like có dùng hàm "VBA.UCASE" cho cả chuỗi tìm và cần tìm để đảm bảo tính chính xác khi dùng Like với "Option Compare Statement" như tài liệu bạn đã dịch ở trên.
Nói rõ thêm về tài liệu của bạn ở trên. Như bài post trước tôi có nói tìm chính xác và tốc độ còn tuỳ thuộc chế độ tìm kiếm hàm đó dùng kiểu gì: kiểu Binary hay Text. Tìm theo kiểu Binary sẽ nhanh hơn kiểu Text.
- Đối với hàm InStr: Nếu dùng kiểu Binary (vbBinaryCompare) thì nó sẽ xem chữ Hoa và chữ thường là khác nhau (A<a), còn nếu dùng kiểu Text (vbTextCompare) thì chữ Hoa cũng như chữ thường (A =a). Đó là lý do trong ví dụ trên của bạn nó trả về vị trí khác nhau khi thay đổi kiểu tìm kiếm.
- Điều này tương tự như toán tử LIKE: gọi là nhạy ký tự. Còn việc dùng dấu * trước hay sau ký tự cần tìm là tuỳ thuộc ý đồ tìm kiếm.

--------------------
01101111 01101110 01100111 01101011 01100101 00110000 00110111 00110001 00110001
 
Lần chỉnh sửa cuối:
Upvote 0
Các bác cho em hỏi thêm : Định dạng trên File được cập nhật ngày 06/06/2019 là số, còn nếu em muốn chuyển sang date dạng "dd/mm/yyyy" thì cần thay đổi function như thế nào ạ. Tks các bác
 
Upvote 0
Tham gia cải tiến code #1:

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


thêm tính năng nhập liệu nữa được không ạ (nghĩa là khi kích vào dòng nào sẽ nhập liệu dòng đó xuống bảng tính)?

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
 
Lần chỉnh sửa cuối:
Upvote 0
Các bác cho em hỏi thêm : Định dạng trên File được cập nhật ngày 06/06/2019 là số, còn nếu em muốn chuyển sang date dạng "dd/mm/yyyy" thì cần thay đổi function như thế nào ạ. Tks các bác

Vấn đề này có nhiều thứ cần bàn nè. Liên quan đến thiết kế Form tìm kiếm.
- Ví trong trong bài #1 là lọc dữ liệu ngay khi gõ 1 ký tự mà đối với tìm kiếm ngày là không phù hợp vì lọc theo ngày là phải lọc nguyên khối ký tự biểu diễn ngày: "09/06/2019". Nếu cột dữ liệu Ngày bạn lưu trong bảng tính Excel dưới dạng TEXT thì nó sẽ tìm được. Nếu lưu đúng định dạng "Date" thì phải xử lý kiểu khác.
- Khi gán cột dạng Date vô mảng (variant) thì nó sẽ tự động chuyển thành dạng Long. Có thể dùng Format ("dd/mm/yyyy") cột ngày trong mảng để hiển thị trên list box cho đúng kiểu nhưng trị nó lưu trong mảng vẫn là dạng Long, Vd: #09/06/2019# --> 43625. Khi đó muốn tìm kiếm ngày thì phải chuyển Date thành Long rồi tìm trong mảng. Bên cạnh đó không thể tìm ngay khi gõ nên phải có textbox riêng để gõ đầy đủ ngày tháng cần tìm rồi mới chạy lệnh tìm kiếm.

Trong thực tế thiết kế ứng dụng tôi cũng chưa thấy ứng dụng nào tìm ngày tháng ngay khi gõ (Find As You Type) mà phải dùng textbox riêng để nhập dữ liệu tìm kiếm. Do vậy ứng dụng FAYT chỉ nên dùng cho các listbox, combox dạng text, number và phải kết hợp với textbox riêng cho dạng Date.

218854

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

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

Hay quá bạn HeSanbi. Code ngắn ngọn quá trời.
Code cũ của tôi và befaint chưa có bẫy lỗi Null cho cái range dữ liệu listbox. Báo lỗi "Out of Memory" nếu range không có dữ liệu.
 
Upvote 0
Hay quá bạn HeSanbi. Code ngắn ngọn quá trời.
Code cũ của tôi và befaint chưa có bẫy lỗi Null cho cái range dữ liệu listbox. Báo lỗi "Out of Memory" nếu range không có dữ liệu.
Viết ứng dụng tìm kiếm, code không tối ưu thì mất đi tốc độ xử lý. Và không nên dùng bẫy lỗi.
Nếu ứng dụng tìm kiếm nhiều cột thì bác cần sử dụng thuật toán như: search binary, tìm kiếm nội suy, ... tốc độ xử lý sẽ nhanh hơn có thể 50%
 
Lần chỉnh sửa cuối:
Upvote 0
Chức năng tìm kiếm này có phải tương tự như clip này không ạ?
 
Upvote 0
Quên là trường hợp này bạn có thể dùng ADO để lấy cột dữ liệu nào muốn cũng dễ hơn.
"Select Ten, Gia From [Range]"
Bạn xem bài của bác HLMT:https://www.giaiphapexcel.com/diend...ile-không-mở-kết-nối-adodb-connection.141551/
Đúng form tìm kiếm em cần.
Các anh có thể hướng dẫn cụ thể chỗ chọn các Cột mình cần tìm. Em mới tìm hiểu VBA, nên chưa nắm bắt được. Em đang cần Form tìm kiếm như này ạ. Bây giờ em muốn chỗ Danh sách các nội dung mình tìm thấy thì Click đúp chuột vào thì Ô textbox tìm kiếm bên trên (hoặc ô textbox khác) sẽ nhận được giá trị tìm kiếm đó ạ. Em cảm ơn các anh chị ạ.
 
Lần chỉnh sửa cuối:
Upvote 0
trước tiên cám ơn cả nhà đã hỗ trợ và cho em học hỏi được rất nhiều,
Còn 1 vấn đề ngoài luồng e cũng ko biết xin tư vấn từ ai, sẵn đây cho e xin hỏi các bác 1 chút
=> Em muốn Copy 1 Cells trong listbox đưa vào Clipboard . Mà mấy nay mò hoài không ra , mong các bác chỉ giáo
Xin 1 lần nữa đa tạ cả nhà
 
Upvote 0
trước tiên cám ơn cả nhà đã hỗ trợ và cho em học hỏi được rất nhiều,
Còn 1 vấn đề ngoài luồng e cũng ko biết xin tư vấn từ ai, sẵn đây cho e xin hỏi các bác 1 chút
=> Em muốn Copy 1 Cells trong listbox đưa vào Clipboard . Mà mấy nay mò hoài không ra , mong các bác chỉ giáo
Xin 1 lần nữa đa tạ cả nhà

Cách làm thì có nhiều nhưng thực sự mục đích xử lý cuối cùng mà bạn muốn là gì? Tại sao phải dùng ClipBoard, dữ liệu bạn lưu trên đó rồi lấy xuống có đáng tin cậy không? Sao không xử lý lấy và gán dữ liệu luôn.
 
Upvote 0
Đúng form tìm kiếm em cần.
Các anh có thể hướng dẫn cụ thể chỗ chọn các Cột mình cần tìm. Em mới tìm hiểu VBA, nên chưa nắm bắt được. Em đang cần Form tìm kiếm như này ạ. Bây giờ em muốn chỗ Danh sách các nội dung mình tìm thấy thì Click đúp chuột vào thì Ô textbox tìm kiếm bên trên (hoặc ô textbox khác) sẽ nhận được giá trị tìm kiếm đó ạ. Em cảm ơn các anh chị ạ.

Bạn xem file đính kèm.
Bạn nên tự mình mày mò code thử tới đâu, bị tắt chỗ nào rồi mới gửi file lên nhờ mọi người hỗ trợ.
Bạn đừng nói tôi là sau khi gán xong, muốn sửa nội dung sau đó lưu lại thì code làm sao nhé :) . Tự thân vận động trước đã.

Code gán dữ liệu từ Listbox xuống Textbox: bạn chú ý cách tôi thiết lập "Tag" của các Textbox trong UserForm.

Mã:
Private Sub lstDanhSachVPP_Click()
    Dim r As Long
    Dim ctl As Control

    If Me.lstDanhSachVPP.ListIndex = -1 Then    'Khong chon dong nao
        Exit Sub
    ElseIf Me.lstDanhSachVPP.ListIndex >= 0 Then    'Da chon dong
        r = Me.lstDanhSachVPP.ListIndex     'so dòng dang chon cua listbox
        For Each ctl In Me.Controls
            If TypeName(ctl) = "TextBox" Or TypeName(ctl) = "ComboBox" Or TypeName(ctl) = "CheckBox" Or TypeName(ctl) = "OptionButton" Then
                If Right(ctl.Tag, 3) = "yes" Then   'Tùy chon textbox nào can gan du lieu. Thiet lap trong Tag.
                    ctl.Value = Me.lstDanhSachVPP.List(r, CInt(Left(ctl.Tag, 1)) - 1)   'Ký tu dau trong tag la so cot trong lstbox
                End If
            End If
        Next ctl
    End If
End Sub
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
File của anh chọn dòng trên cùng không được, chỉnh lại
Mã:
ElseIf Me.lstDanhSachVPP.ListIndex >= 1 Then    'Da chon dong
chỉnh lại=>>>>ElseIf Me.lstDanhSachVPP.ListIndex >= 0 Then    'Da chon dong
 
Upvote 0
Cách làm thì có nhiều nhưng thực sự mục đích xử lý cuối cùng mà bạn muốn là gì? Tại sao phải dùng ClipBoard, dữ liệu bạn lưu trên đó rồi lấy xuống có đáng tin cậy không? Sao không xử lý lấy và gán dữ liệu luôn.
Mục đích: là em đang làm 1 Form gồm các trường "Subject Mail" & "Nội dung Mail" theo template được em định dạng sẵn
=> Vì công việc đặc thù, em phải phản hồi mail case by case theo chủ đề và khách hàng
=> Hiện tại em đã nghiên cứu được cách copy all list box nhưng có vẻ nhưng ứng dụng vào thì không thích hợp với mục đích của mình
Code như sau :

Dim Dt3 As DataObject, Tm3, i3, j3
Set Dt3 = New DataObject
For i3 = 0 To Me.lstbaocao.ListCount - 1
For j3 = 0 To lstbaocao.ColumnCount - 1
Tm3 = Tm3 & Me.lstbaocao.List(i3, j3) & IIf(j3 < Me.lstbaocao.ColumnCount - 1, vbTab, vbNewLine)
Next
Next
Dt3.SetText Tm3
Dt3.PutInClipboard

-> Các bác thông thạo nhiều tính huống và có nghiên cứu đủ sâu và rộng về VBA nên mong các bác hỗ trợ em
Cám ơn các bác
 
Upvote 0
Mục đích: là em đang làm 1 Form gồm các trường "Subject Mail" & "Nội dung Mail" theo template được em định dạng sẵn
=> Vì công việc đặc thù, em phải phản hồi mail case by case theo chủ đề và khách hàng
=> Hiện tại em đã nghiên cứu được cách copy all list box nhưng có vẻ nhưng ứng dụng vào thì không thích hợp với mục đích của mình

Vậy tức là đối với mỗi người nhận bạn soạn thông tin riêng, lưu thành các record như trong hình listbox bạn gửi mấy này trước, sau đó muốn chọn hàng loạt người nhận rồi bấm gửi email một lúc luôn hay sao?
Nếu theo kểu đó bạn nên thiết kế form phụ tuỳ chọn ds người nhận rồi dùng vòng lặp duyệt qua từng người gọi code tạo email từng người rồi gửi.
 
Lần chỉnh sửa cuối:
Upvote 0
Các cao nhân cho mình hỏi chút bình thường mình dùng Excel khoảng 60 đến 80k dòng thấy file load rất chậm và đơ luôn máy mình kiểm tra thấy nguyên nhân là có rất nhiều name Range tồn tại. Vậy mình dùng cái bảng cứ mỗi lần thêm mới dòng mình xóa hết name range đi có dc ko vậy hãy có cách nào khác ko
Bài đã được tự động gộp:

Mình muốn tạo mã tự động trong excel theo cái định dạng yyyymmddhhss (lấy theo mốc thời gian hiện tại) có được ko mọi ng.
Ví dụ mình có một cái bảng, mình có một nút button, khi click sẽ tự động tạo dòng mới và mã id mới, ví dụ: 20200410224822
 
Lần chỉnh sửa cuối:
Upvote 0
. . . . . . .
Mình muốn tạo mã tự động trong excel theo cái định dạng yyyymmddhhss (lấy theo mốc thời gian hiện tại) có được ko mọi ng.
Ví dụ mình có một cái bảng, mình có một nút button, khi click sẽ tự động tạo dòng mới và mã id mới, ví dụ: 20200410224822
Mã đó theo mình chứa quá nhiều ký số & như vậy sẽ có độ dài quá lớn
Nên chăng xài vầy YMDHMS, như ví dụ J4AV8V mà ở đây:
J là năm 2020, năm sau sẽ là K
4 là tháng 4, tháng 11 sẽ là B
A là ngày 10; D sẽ là ngày 13
V là giờ thứ 22 trong ngày
. . . .
Có vậy mã của ta sẽ có độ dài luôn như nhau & quan trọng là chỉ 6 kí tự (hay có kí số)
Nếu ưng ý, mình sẽ giúp bạn 2 hàm tự tạo chuyển đổi qua lại giữa mã ngày gợi ý bên trên & ngày giờ theo qui luật (?)

& lưu ý lần sau nên tạo chủ đề mới cho mình, đừng viết vô chủ đề của người khác sau này khó cho bạn trong việc tìm kiếm
 
Lần chỉnh sửa cuối:
Upvote 0
Mã đó theo mình chứa quá nhiều ký số & như vậy sẽ có độ dài quá lớn
Nên chăng xài vầy YMDHMS, như ví dụ J4AV8V mà ở đây:
J là năm 2020, năm sau sẽ là K
4 là tháng 4, tháng 11 sẽ là B
A là ngày 10; D sẽ là ngày 13
V là giờ thứ 22 trong ngày
. . . .
Có vậy mã của ta sẽ có độ dài luôn như nhau & quan trọng là chỉ 6 kí tự (hay có kí số)
Nếu ưng ý, mình sẽ giúp bạn 2 hàm tự tạo chuyển đổi qua lại giữa mã ngày gợi ý bên trên & ngày giờ theo qui luật (?)

& lưu ý lần sau nên tạo chủ đề mới cho mình, đừng viết vô chủ đề của người khác sau này khó cho bạn trong việc tìm kiếm
Vậy bạn chỉ giúp mình với
Mình Ko biết nhiều về có dễ VBA
 
Upvote 0
Mã đó theo mình chứa quá nhiều ký số & như vậy sẽ có độ dài quá lớn
Nên chăng xài vầy YMDHMS, như ví dụ J4AV8V mà ở đây:
J là năm 2020, năm sau sẽ là K
4 là tháng 4, tháng 11 sẽ là B
A là ngày 10; D sẽ là ngày 13
V là giờ thứ 22 trong ngày
. . . .
Có vậy mã của ta sẽ có độ dài luôn như nhau & quan trọng là chỉ 6 kí tự (hay có kí số)
Nếu ưng ý, mình sẽ giúp bạn 2 hàm tự tạo chuyển đổi qua lại giữa mã ngày gợi ý bên trên & ngày giờ theo qui luật (?)

& lưu ý lần sau nên tạo chủ đề mới cho mình, đừng viết vô chủ đề của người khác sau này khó cho bạn trong việc tìm kiếm
Bác làm thế này , dùng lâu dài có thể sẽ dính lỗi kiểu Y2K, có phải không ạ?
(Chào bác SA, bác vẫn sung sức và tràn đầy năng lượng, giờ thấy bác chiến đấu các mảng luôn)
 
Upvote 0
Bác làm thế này , dùng lâu dài có thể sẽ dính lỗi kiểu Y2K, có phải không ạ?
(Chào bác SA, bác vẫn sung sức và . . . )
Đúng, mà còn sử dụng đến 60 năm nữa cũng được, nếu biến hóa đi 1 chút nữa: Vì 3 năm chỉ cho 36 tháng, cho nên ta có thể làm sao đó 1 ký tự có thể đại diện cho 3 năm! (Nhưng dù sao cũng tới chừng đó hay thêm chút nữa mà thôi. . .bằng cách thêm ký tự trời ơi vô 'Alf', như '@ $ # %&,. . . )
:D
}}}}}


BS:
Chú mày đang ở đâu vậy & sinh nhật này có dự không?
 
Lần chỉnh sửa cuối:
Upvote 0
Bác viết thêm hàm đọc ngược lại cái mã hóa nữa thì mới đẹp.
Sẵn lòng thôi, nhưng tách ra làm 2 đáp án ngày riêng & thời gian riêng
PHP:
Const Alf As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"

Function TGMa(Ma As String, Optional Dat As Integer = 0)
 Dim Nm As Integer, VTr As Integer, Th As Integer, Ng As Integer
  
 If Dat Then
    VTr = InStr(Alf, Mid(Ma, 4, 1)):        Nm = VTr - 1
    VTr = CInt(Mid(Ma, 5, 2))
    TGMa = TimeSerial(Nm, VTr, 0)
 Else
    VTr = InStr(Alf, Left(Ma, 1)):         Nm = VTr + 2000
    VTr = InStr(Alf, Mid(Ma, 2, 1)):       Th = VTr - 1
    VTr = InStr(Alf, Mid(Ma, 3, 1)):       Ng = VTr - 1
    TGMa = DateSerial(Nm, Th, Ng)
 End If
End Function
 
Upvote 0
:) 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 :)

Như thế này đi anh, bây giờ mình phải thêm code như thế nào anh.

GPE listbox.png
 

File đính kèm

Upvote 0
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.
Chào anh, nhờ anh hướng dẫn giúp em chỉnh sửa lại code nếu số dòng và số cột của em khác với file của anh
Vùng dữ liệu A7:I2000, các cột địng dạng số là :E,F,G,H => thì phải chỉnh sửa thế nào ạ
Cảm ơn anh
 
Upvote 0
Chào anh, nhờ anh hướng dẫn giúp em chỉnh sửa lại code nếu số dòng và số cột của em khác với file của anh
Vùng dữ liệu A7:I2000, các cột địng dạng số là :E,F,G,H => thì phải chỉnh sửa thế nào ạ
Cảm ơn anh

- Sửa vùng dữ liệu: Vô Userform "frmSearch", bạn kiếm cái Sub "ganSourceListbox", khai báo Range ("A2") --> "A7"

Mã:
Set oRngLstBx1 = Range(Range("A2"), Range("A2").End(xlDown).End(xlToRight))

- Sửa định dạng cột: kiếm sub "Userform_Initialize", kiếm dòng code bên dưới và thêm 3 dòng cho các cột F,G,H

Mã:
With Me.lstDanhSachVPP
        For lngIndex = 0 To .ListCount - 1
            .List(lngIndex, 4) = (Format(Val(.List(lngIndex, 4)), "$#,##0.00")) 'Cot E
            .List(lngIndex, 5) = (Format(Val(.List(lngIndex, 5)), "#,##0.00"))  'Cot F
            .List(lngIndex, 6) = (Format(Val(.List(lngIndex, 6)), "#,##0.00"))  'Cot G
            .List(lngIndex, 7) = (Format(Val(.List(lngIndex, 7)), "#,##0.00"))  'Cot H
        Next
    End With
 
Upvote 0
- Sửa vùng dữ liệu: Vô Userform "frmSearch", bạn kiếm cái Sub "ganSourceListbox", khai báo Range ("A2") --> "A7"

Mã:
Set oRngLstBx1 = Range(Range("A2"), Range("A2").End(xlDown).End(xlToRight))

- Sửa định dạng cột: kiếm sub "Userform_Initialize", kiếm dòng code bên dưới và thêm 3 dòng cho các cột F,G,H

Mã:
With Me.lstDanhSachVPP
        For lngIndex = 0 To .ListCount - 1
            .List(lngIndex, 4) = (Format(Val(.List(lngIndex, 4)), "$#,##0.00")) 'Cot E
            .List(lngIndex, 5) = (Format(Val(.List(lngIndex, 5)), "#,##0.00"))  'Cot F
            .List(lngIndex, 6) = (Format(Val(.List(lngIndex, 6)), "#,##0.00"))  'Cot G
            .List(lngIndex, 7) = (Format(Val(.List(lngIndex, 7)), "#,##0.00"))  'Cot H
        Next
    End With
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
 
Lần chỉnh sửa cuối:
Upvote 0
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.
 
Upvote 0
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
 
Upvote 0
:) 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 ạ.
 

File đính kèm

Upvote 0
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.

Mã:
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

Mã:
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:

Mã:
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
 

File đính kèm

Upvote 0
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.

Mã:
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

Mã:
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:

Mã:
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 ạ.
 
Upvote 0
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:

Mã:
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:
Mã:
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 :
Mã:
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:

Mã:
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 ạ.
 

File đính kèm

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

PHP:
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
 
Upvote 0
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
 
Upvote 0
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 ạ
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
@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.
 
Upvote 0
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.
 

File đính kèm

  • screenshot_1621559152.png
    screenshot_1621559152.png
    27 KB · Đọc: 19
Upvote 0
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:

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)


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
1622627097643.png
Gõ từ " ao phao" cũng không thấy

1622627332022.png
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
1622627430324.png

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

1622627582231.png

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.
 
Lần chỉnh sửa cuối:
Upvote 0
Upvote 0
anh @ongke0711 wa siêu cao thủ. em thành viên mới cũng đang có cùng thắc như bạn iloveit anh Ongke giúp cho em code này đc không ah

Bạn nói tôi nhột quá..:p

Lưu xuống sheet thì đơn giản rồi.

Mã:
Private Sub lstDanhSachVPP_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    '// Luu xuong Sheet
    Dim i As Long, lr As Long
    lr = Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
    For i = 1 To Me.lstDanhSachVPP.ColumnCount - 1  'bo cot Stt -cot (0)
        Worksheets("Sheet1").Range("A" & lr).Offset(1, i - 1) = Me.lstDanhSachVPP.List(Me.lstDanhSachVPP.ListIndex, i)
    Next i
    MsgBox "Da luu"
    
End Sub

Lấy lại file của bài #44, thêm cái thủ tục ở trên vô Userform.
 
Upvote 0
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:

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)


View attachment 218600
Chào các anh/chị trên diễn đàn.
Xin được các anh/chị giúp em để có thể:
1/ Copy Nội dung trực tiếp trong ô nào đó ở giao diện Form (khi chọn ô đó)
2/ Đi tới ô chứa nội dung trong excel khi Click đúp chuột trái vào ô chứa nội dung từ giao diện Form.

Em xin chân thành cảm ơn!
Giup.png
 

File đính kèm

Upvote 0
Anh ongke0711 và thầy befaint Cho em xin file tìm kiếm có thể Checked chọn tìm kiếm theo cột như vậy với ạ?

File trong hình là Form của MS Access. Các checkbox dùng chọn cột dữ liệu nào được dùng để tìm kiếm theo từ khoá. Trong chủ để này tôi và các bạn đã thiết kế mặc định tìm kiếm dữ liệu từ "tất cả" các cột trong bảng rồi, không cần giới hạn cột tìm kiếm làm chi.
 
Upvote 0
File trong hình là Form của MS Access. Các checkbox dùng chọn cột dữ liệu nào được dùng để tìm kiếm theo từ khoá. Trong chủ để này tôi và các bạn đã thiết kế mặc định tìm kiếm dữ liệu từ "tất cả" các cột trong bảng rồi, không cần giới hạn cột tìm kiếm làm chi.
Vâng, xin cảm ơn anh!
 
Upvote 0
1/ Copy Nội dung trực tiếp trong ô nào đó ở giao diện Form (khi chọn ô đó)
2/ Đi tới ô chứa nội dung trong excel khi Click đúp chuột trái vào ô chứa nội dung từ giao diện Form.

1. Copy nội dung cũng có nhiều cách. Khi click đôi vào Textbox thì gán giá trị của Textbox đó vào một biến nào đó, khi cần thì lấy biến đó ra sử dụng. Còn muốn copy vào Clipboard thì code cho cái API này cũng có đầy trên mạng. Cái quan trọng là bạn chọn sự kiện nào để kích hoạt gọi hàm copy thôi. Hàm dùng API copy vào Clipboard tôi để bên dưới.

2. Tác vụ này bạn chỉ cần tách ra 2 công việc:
- Khi click đúp vào nội dung nào đó trên Form là lấy ngay cái thông tin từ khoá chính của dòng dữ liệu đó. Cái khoá chính này giúp phân biệt giữa các dòng dữ liệu với nhau và tất nhiên phải không trùng. Cụ thể trong Form của bạn là cột [STT].
- Sau khi có từ khoá chính rồi thì dùng phương thức Find của Excel tìm ra dòng chứa khoá chính đó rồi di chuyển thôi.

Mã:
Private Sub lstDanhSachVPP_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

    Dim SearchRange As Range
    Dim sCrit As String, rowNum As Long

    sCrit = Me.lstDanhSachVPP.Column(0)     'STT
    Set SearchRange = Sheets("Excel").Range("A1", Range("A65536").End(xlUp))
    rowNum = SearchRange.Find(sCrit, LookIn:=xlValues, lookat:=xlWhole).Row
    
    SearchRange.Cells(rowNum, 2).Select

End Sub




Mã:
Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function OpenClipboard Lib "User32" (ByVal hWnd As LongPtr) As LongPtr
    Private Declare PtrSafe Function EmptyClipboard Lib "User32" () As LongPtr
    Private Declare PtrSafe Function CloseClipboard Lib "User32" () As LongPtr
    Private Declare PtrSafe Function IsClipboardFormatAvailable Lib "User32" (ByVal wFormat As LongPtr) As LongPtr
    Private Declare PtrSafe Function GetClipboardData Lib "User32" (ByVal wFormat As LongPtr) As LongPtr
    Private Declare PtrSafe Function SetClipboardData Lib "User32" (ByVal wFormat As LongPtr, ByVal hMem As LongPtr) As LongPtr
    Private Declare PtrSafe Function GlobalAlloc Lib "kernel32.dll" (ByVal wFlags As Long, ByVal dwBytes As Long) As LongPtr
    Private Declare PtrSafe Function GlobalLock Lib "kernel32.dll" (ByVal hMem As LongPtr) As LongPtr
    Private Declare PtrSafe Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As LongPtr) As LongPtr
    Private Declare PtrSafe Function GlobalSize Lib "kernel32" (ByVal hMem As LongPtr) As Long
    Private Declare PtrSafe Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyW" (ByVal lpString1 As Any, ByVal lpString2 As Any) As LongPtr
#Else
    Private Declare Function OpenClipboard Lib "user32.dll" (ByVal hWnd As Long) As Long
    Private Declare Function EmptyClipboard Lib "user32.dll" () As Long
    Private Declare Function CloseClipboard Lib "user32.dll" () As Long
    Private Declare Function IsClipboardFormatAvailable Lib "user32.dll" (ByVal wFormat As Long) As Long
    Private Declare Function GetClipboardData Lib "user32.dll" (ByVal wFormat As Long) As Long
    Private Declare Function SetClipboardData Lib "user32.dll" (ByVal wFormat As Long, ByVal hMem As Long) As Long
    Private Declare Function GlobalAlloc Lib "kernel32.dll" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
    Private Declare Function GlobalLock Lib "kernel32.dll" (ByVal hMem As Long) As Long
    Private Declare Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As Long) As Long
    Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
    Private Declare Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyW" (ByVal lpString1 As Long, ByVal lpString2 As Long) As Long
#End If

Public Sub SetClipboard(sUniText As String)

    #If VBA7 Then
        Dim iStrPtr As LongPtr
        Dim iLock As LongPtr
    #Else
        Dim iStrPtr As Long
        Dim iLock As Long
    #End If

    Dim iLen As Long

    Const GMEM_MOVEABLE As Long = &H2
    Const GMEM_ZEROINIT As Long = &H40
    Const CF_UNICODETEXT As Long = &HD

    OpenClipboard 0&
    EmptyClipboard
    iLen = LenB(sUniText) + 2&
    iStrPtr = GlobalAlloc(GMEM_MOVEABLE + GMEM_ZEROINIT, iLen)
    iLock = GlobalLock(iStrPtr)
    lstrcpy iLock, StrPtr(sUniText)
    GlobalUnlock iStrPtr
    SetClipboardData CF_UNICODETEXT, iStrPtr
    CloseClipboard
End Sub

Public Function GetClipboard() As String
    #If VBA7 Then
        Dim iStrPtr As LongPtr
        Dim iLock As LongPtr
    #Else
        Dim iStrPtr As Long
        Dim iLock As Long
    #End If
    Dim iLen As Long
    Dim sUniText As String

    Const CF_UNICODETEXT As Long = 13&

    OpenClipboard 0&

    If IsClipboardFormatAvailable(CF_UNICODETEXT) Then
        iStrPtr = GetClipboardData(CF_UNICODETEXT)
        If iStrPtr Then
            iLock = GlobalLock(iStrPtr)
            iLen = GlobalSize(iStrPtr)
            sUniText = String$(iLen \ 2& - 1&, vbNullChar)
            lstrcpy StrPtr(sUniText), iLock
            GlobalUnlock iStrPtr
        End If
        GetClipboard = sUniText
    End If

    CloseClipboard
End Function


'// Test hàm -----------------------------------------
Sub CopyToClipBoard()
    SetClipboard Sheets("Excel").Range("B2").Value
End Sub

Sub paste()
    Sheets("Excel").Range("A14").Value = GetClipboard
End Sub
 
Upvote 0
1. Copy nội dung cũng có nhiều cách. Khi click đôi vào Textbox thì gán giá trị của Textbox đó vào một biến nào đó, khi cần thì lấy biến đó ra sử dụng. Còn muốn copy vào Clipboard thì code cho cái API này cũng có đầy trên mạng. Cái quan trọng là bạn chọn sự kiện nào để kích hoạt gọi hàm copy thôi. Hàm dùng API copy vào Clipboard tôi để bên dưới.

2. Tác vụ này bạn chỉ cần tách ra 2 công việc:
- Khi click đúp vào nội dung nào đó trên Form là lấy ngay cái thông tin từ khoá chính của dòng dữ liệu đó. Cái khoá chính này giúp phân biệt giữa các dòng dữ liệu với nhau và tất nhiên phải không trùng. Cụ thể trong Form của bạn là cột [STT].
- Sau khi có từ khoá chính rồi thì dùng phương thức Find của Excel tìm ra dòng chứa khoá chính đó rồi di chuyển thôi.

Mã:
Private Sub lstDanhSachVPP_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

    Dim SearchRange As Range
    Dim sCrit As String, rowNum As Long

    sCrit = Me.lstDanhSachVPP.Column(0)     'STT
    Set SearchRange = Sheets("Excel").Range("A1", Range("A65536").End(xlUp))
    rowNum = SearchRange.Find(sCrit, LookIn:=xlValues, lookat:=xlWhole).Row
 
    SearchRange.Cells(rowNum, 2).Select

End Sub




Mã:
Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function OpenClipboard Lib "User32" (ByVal hWnd As LongPtr) As LongPtr
    Private Declare PtrSafe Function EmptyClipboard Lib "User32" () As LongPtr
    Private Declare PtrSafe Function CloseClipboard Lib "User32" () As LongPtr
    Private Declare PtrSafe Function IsClipboardFormatAvailable Lib "User32" (ByVal wFormat As LongPtr) As LongPtr
    Private Declare PtrSafe Function GetClipboardData Lib "User32" (ByVal wFormat As LongPtr) As LongPtr
    Private Declare PtrSafe Function SetClipboardData Lib "User32" (ByVal wFormat As LongPtr, ByVal hMem As LongPtr) As LongPtr
    Private Declare PtrSafe Function GlobalAlloc Lib "kernel32.dll" (ByVal wFlags As Long, ByVal dwBytes As Long) As LongPtr
    Private Declare PtrSafe Function GlobalLock Lib "kernel32.dll" (ByVal hMem As LongPtr) As LongPtr
    Private Declare PtrSafe Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As LongPtr) As LongPtr
    Private Declare PtrSafe Function GlobalSize Lib "kernel32" (ByVal hMem As LongPtr) As Long
    Private Declare PtrSafe Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyW" (ByVal lpString1 As Any, ByVal lpString2 As Any) As LongPtr
#Else
    Private Declare Function OpenClipboard Lib "user32.dll" (ByVal hWnd As Long) As Long
    Private Declare Function EmptyClipboard Lib "user32.dll" () As Long
    Private Declare Function CloseClipboard Lib "user32.dll" () As Long
    Private Declare Function IsClipboardFormatAvailable Lib "user32.dll" (ByVal wFormat As Long) As Long
    Private Declare Function GetClipboardData Lib "user32.dll" (ByVal wFormat As Long) As Long
    Private Declare Function SetClipboardData Lib "user32.dll" (ByVal wFormat As Long, ByVal hMem As Long) As Long
    Private Declare Function GlobalAlloc Lib "kernel32.dll" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
    Private Declare Function GlobalLock Lib "kernel32.dll" (ByVal hMem As Long) As Long
    Private Declare Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As Long) As Long
    Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
    Private Declare Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyW" (ByVal lpString1 As Long, ByVal lpString2 As Long) As Long
#End If

Public Sub SetClipboard(sUniText As String)

    #If VBA7 Then
        Dim iStrPtr As LongPtr
        Dim iLock As LongPtr
    #Else
        Dim iStrPtr As Long
        Dim iLock As Long
    #End If

    Dim iLen As Long

    Const GMEM_MOVEABLE As Long = &H2
    Const GMEM_ZEROINIT As Long = &H40
    Const CF_UNICODETEXT As Long = &HD

    OpenClipboard 0&
    EmptyClipboard
    iLen = LenB(sUniText) + 2&
    iStrPtr = GlobalAlloc(GMEM_MOVEABLE + GMEM_ZEROINIT, iLen)
    iLock = GlobalLock(iStrPtr)
    lstrcpy iLock, StrPtr(sUniText)
    GlobalUnlock iStrPtr
    SetClipboardData CF_UNICODETEXT, iStrPtr
    CloseClipboard
End Sub

Public Function GetClipboard() As String
    #If VBA7 Then
        Dim iStrPtr As LongPtr
        Dim iLock As LongPtr
    #Else
        Dim iStrPtr As Long
        Dim iLock As Long
    #End If
    Dim iLen As Long
    Dim sUniText As String

    Const CF_UNICODETEXT As Long = 13&

    OpenClipboard 0&

    If IsClipboardFormatAvailable(CF_UNICODETEXT) Then
        iStrPtr = GetClipboardData(CF_UNICODETEXT)
        If iStrPtr Then
            iLock = GlobalLock(iStrPtr)
            iLen = GlobalSize(iStrPtr)
            sUniText = String$(iLen \ 2& - 1&, vbNullChar)
            lstrcpy StrPtr(sUniText), iLock
            GlobalUnlock iStrPtr
        End If
        GetClipboard = sUniText
    End If

    CloseClipboard
End Function


'// Test hàm -----------------------------------------
Sub CopyToClipBoard()
    SetClipboard Sheets("Excel").Range("B2").Value
End Sub

Sub paste()
    Sheets("Excel").Range("A14").Value = GetClipboard
End Sub
Dạ em cảm ơn anh, copy code trên vào thay thế code trong Form à anh?
Nhờ anh hướng dẫn em rõ hơn chút ạ?
 
Lần chỉnh sửa cuối:
Upvote 0
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:

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)


View attachment 218600
Add cho em hỏi: tìm kiếm trong Form listbox nhưng khi tìm được trong giao diện Form nhưng không thể tác động được vào giao diện đó:
Nghĩa là chỉ xem trên giao diện đó, sau đó lại tắt giao diện đó đi, muốn thao tác hoặc chỉnh sửa gì lại phải vào trực tiếp excel để thao tác.
Trong trường hợp muốn tìm 10 hàng chả hạn: tìm được trong Form listbox. Nhưng sau đó vào excel làm sao để tới được 10 hàng đã tìm trong giao diện đó: phải ghi ra giấy 10 hàng đã tìm được trong Form listbox sau đó tìm lại bằng số thứ tự trực tiếp trên exel.
Rất mong ad giúp em vấn đề em nêu trên.
 
Upvote 0
Add cho em hỏi: tìm kiếm trong Form listbox nhưng khi tìm được trong giao diện Form nhưng không thể tác động được vào giao diện đó:
Nghĩa là chỉ xem trên giao diện đó, sau đó lại tắt giao diện đó đi, muốn thao tác hoặc chỉnh sửa gì lại phải vào trực tiếp excel để thao tác.
Trong trường hợp muốn tìm 10 hàng chả hạn: tìm được trong Form listbox. Nhưng sau đó vào excel làm sao để tới được 10 hàng đã tìm trong giao diện đó: phải ghi ra giấy 10 hàng đã tìm được trong Form listbox sau đó tìm lại bằng số thứ tự trực tiếp trên exel.
Rất mong ad giúp em vấn đề em nêu trên.

Vụ này tuỳ thuộc vào khả năng thiết kế ứng dụng của bạn. Bạn phải định hướng thiết kế, áp dụng bộ code tìm kiếm trong demo ở trên vào qui trình xử lý nào, sau khi tìm kiếm sẽ đến các tác vụ gì, xử lý ra sao v.v...Cái Form tôi làm mẫu ở trên đâu phải là cái Form chết mà tuỳ mỗi người ứng dụng vào việc thiết kế lập trình của họ.
Có người thì muốn sau khi tìm thấy dòng dữ liệu thì muốn nó hiển thị lên các Textbox trên chính cái Form tìm kiếm để có thể chỉnh sửa rồi lưu xuống sheet. Hoặc khi click đúp chọn nó thì sẽ mở cái Form khác có chứa dữ liệu vừa chọn để thực hiện các thao tác gì đó.
Có người muốn tìm kiếm dữ liệu trong khoảng thời gian nào đó để báo cáo, in ấn, để xoá nếu nhập liệu sai v.v..
Nói chung bạn phải biết tích hợp các mẫu code nhỏ thực hiện một tác vụ nào đó vào một qui trình xử lý, tác vụ lớn của bạn.

(Hình minh hoạ áp dụng code tìm kiếm vào Form nhập liệu. Form của Ms Access. Xin đừng xin file :) )

Screen Shot 2021-06-30 at 20.59.05.png
 
Lần chỉnh sửa cuối:
Upvote 0
Vụ này tuỳ thuộc vào khả năng thiết kế ứng dụng của bạn. Bạn phải định hướng thiết kế, áp dụng bộ code tìm kiếm trong demo ở trên vào qui trình xử lý nào, sau khi tìm kiếm sẽ đến các tác vụ gì, xử lý ra sao v.v...Cái Form tôi làm mẫu ở trên đâu phải là cái Form chết mà tuỳ mỗi người ứng dụng vào việc thiết kế lập trình của họ.
Có người thì muốn sau khi tìm thấy dòng dữ liệu thì muốn nó hiển thị lên các Textbox trên chính cái Form tìm kiếm để có thể chỉnh sửa rồi lưu xuống sheet. Hoặc khi click đúp chọn nó thì sẽ mở cái Form khác có chứa dữ liệu vừa chọn để thực hiện các thao tác gì đó.
Có người muốn tìm kiếm dữ liệu trong khoảng thời gian nào đó để báo cáo, in ấn, để xoá nếu nhập liệu sai v.v..
Nói chung bạn phải biết tích hợp các mẫu code nhỏ thực hiện một tác vụ nào đó vào một qui trình xử lý, tác vụ lớn của bạn.

View attachment 261571
Em chưa biết về code.
Nếu có thời gian xin được anh giúp ạ!
 
Upvote 0
Code các anh viết thật tuyệt vời. Áp dụng và học hỏi được rất nhiều
Nhờ anh chị hướng dẫn chỗ này giúp em với ạ. Nếu để các tuỳ chọn trong Listbox như sau
1. Liststyle = 1-frmListstyleOption
2. MultiSelect
Khi tìm kiếm thì Listbox có sự co lại điều chỉnh kích thước của listbox rất xấu khi dùng trên form. Nhờ các anh chị hỗ trợ giúp chỗ này ạ

Hình 1: Tuỳ chọn listbox
1658813323330.png
Hình 2: Khi Load Form
1658813501026.png
Hình 3: Khi tìm kiếm
1658813481850.png
 
Upvote 0
Code các anh viết thật tuyệt vời. Áp dụng và học hỏi được rất nhiều
Nhờ anh chị hướng dẫn chỗ này giúp em với ạ. Nếu để các tuỳ chọn trong Listbox như sau
1. Liststyle = 1-frmListstyleOption
2. MultiSelect
Khi tìm kiếm thì Listbox có sự co lại điều chỉnh kích thước của listbox rất xấu khi dùng trên form. Nhờ các anh chị hỗ trợ giúp chỗ này ạ

Hình 1: Tuỳ chọn listbox
View attachment 279279
Hình 2: Khi Load Form
View attachment 279281
Hình 3: Khi tìm kiếm
View attachment 279280
Để ListBox không tự điều chỉnh kích thước (chủ yếu là chiều cao) thì nên chọn mục IntergralHeight=False nhé bạn. Nhưng điều này sẽ dẫn đến hàng cuối cùng bị mất một phần hoặc toàn bộ, vì thế sau khi lọc hay điều chỉnh list, ta add thêm 1 dòng rỗng nữa.
VD: ListBox1.AddItem Empty, ListBox1.ListCount
 
Upvote 0
Để ListBox không tự điều chỉnh kích thước (chủ yếu là chiều cao) thì nên chọn mục IntergralHeight=False nhé bạn. Nhưng điều này sẽ dẫn đến hàng cuối cùng bị mất một phần hoặc toàn bộ, vì thế sau khi lọc hay điều chỉnh list, ta add thêm 1 dòng rỗng nữa.
VD: ListBox1.AddItem Empty, ListBox1.ListCount
Dạ em thêm dòng trống như anh hướng dẫn vẫn không được anh
1658820499655.png

1658820673115.png
 
Lần chỉnh sửa cuối:
Upvote 0
Để ListBox không tự điều chỉnh kích thước (chủ yếu là chiều cao) thì nên chọn mục IntergralHeight=False nhé bạn.

Anh có nhầm gì không? Theo hình thớt gửi thì listbox bị thu hẹp chiều ngang cơ mà.

Thớt thấy hay nhưng không hiểu bản chất để vận dụng, thản nhiên kết luận "Listbox có sự co lại điều chỉnh kích thước".
 
Upvote 0
Anh có nhầm gì không? Theo hình thớt gửi thì listbox bị thu hẹp chiều ngang cơ mà.

Thớt thấy hay nhưng không hiểu bản chất để vận dụng, thản nhiên kết luận "Listbox có sự co lại điều chỉnh kích thước".
Không biết file đó viết code thế nào, có điều chỉnh độ rộng của cột hay không nên mình không can thiệp được, nhưng thông thường nó sẽ tự điều chỉnh chiều cao của ListBox.
 
Upvote 0

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

Back
Top Bottom