Tìm kiếm khi gõ trên TextBox, lọc nhiều cột và trả kết quả lên Listbox (1 người xem)

Elx Liên hệ QC

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

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
Hoàng Trọng Nghĩa

Hoàng Trọng Nghĩa

Chuyên gia GPE
Thành viên BQT
Moderator
Tham gia
17/8/08
Bài viết
8,662
Được thích
16,725
Giới tính
Nam
Từ bài viết này:

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


Tôi chia sẻ thêm cách lọc nhiều cột bằng ADO (nhưng tôi đánh giá không cao vì tốc độ rất chậm):

PHP: 
Private Sub txtChuoiTK_Change()
    With txtChuoiTK
        If .Text = "" Then
            lstDanhSachVPP.Column = priArrData
        Else
            Dim strSQL As String
            On Error Resume Next
            priObjConnect.Open priStrADO
            strSQL = "SELECT [ID],[MaSP2],[TenSP],[Dvt],Format([GiaGoc],'#,##0'),[MinReorder] FROM [tblDMSP$] " & _
                     "WHERE [ID] LIKE '%" & .Text & "%' OR [MaSP2] LIKE '%" & .Text & "%' OR [TenSP] LIKE '%" & .Text & "%' " & _
                     "OR [Dvt] LIKE '%" & .Text & "%' OR [GiaGoc] LIKE '%" & .Text & "%' OR [MinReorder] LIKE '%" & .Text & "%'"
            priObjRecord.Open strSQL, priObjConnect, 1, 3
            If Not priObjRecord.EOF Then
                lstDanhSachVPP.Column = priObjRecord.GetRows()
            Else
                lstDanhSachVPP.Clear
            End If
            lstDanhSachVPP.AddItem Empty
            priObjRecord.Close
            priObjConnect.Close
        End If
    End With
End Sub
Bài đã được tự động gộp:

Nếu các bạn muốn sắp xếp (sort) theo cột nào thì thêm ORDER BY [tên cột] vào câu lệnh:

Rich (BB code): 
            strSQL = "SELECT [ID],[MaSP2],[TenSP],[Dvt],Format([GiaGoc],'#,##0'),[MinReorder] FROM [tblDMSP$] " & _
                     "WHERE [ID] LIKE '%" & .Text & "%' OR [MaSP2] LIKE '%" & .Text & "%' OR [TenSP] LIKE '%" & .Text & "%' " & _
                     "OR [Dvt] LIKE '%" & .Text & "%' OR [GiaGoc] LIKE '%" & .Text & "%' OR [MinReorder] LIKE '%" & .Text & "%' " & _
                     "ORDER BY [TenSP]"

Nhưng bài #1 này chủ yếu là có thể dùng ADO để lọc nhiều cột, tôi sẽ giới thiệu thuật toán lọc mới của tôi về chủ đề này ở bài #2. Nó vẫn có thể chạy mượt mà với 20.000 dòng.
 

File đính kèm

Lần chỉnh sửa cuối:
Sắp xếp theo thời gian sắp xếp theo bầu chọn
Như đã nói ở bài #1, bài này tôi viết code lại ngắn gọn và chạy nhanh chóng.

1) Thủ tục Format Number trong mảng:

Mã: 
Sub ColFormat(ByVal lstListBox As MSForms.ListBox, ByRef arrSource, ByVal strFormat As String, ParamArray arrColNum())
    Dim dblValue As Double
    Dim r As Long, ur As Long
    Dim c As Byte, uc As Byte
    ur = UBound(arrSource, 2): uc = UBound(arrColNum)
    For r = 0 To ur
        For c = 0 To uc
            dblValue = Val(arrSource(arrColNum(c), r))
            If dblValue = 0 Then
                arrSource(arrColNum(c), r) = 0
            Else
                arrSource(arrColNum(c), r) = Format(dblValue, strFormat)
            End If
        Next
    Next
    lstListBox.Column = arrSource
End Sub

Cấu trúc: (Tên thủ tục ListBox, Mảng cần thay đổi, Cách định dạnh, Các cột cần định dạng)
Mã: 
ColFormat lstDanhSachVPP, priArrData, "#,##0", 4, 5

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

Mã: 
Sub MultiColumnFilter(ByVal strText As String, ByVal lstListBox As MSForms.ListBox, ByVal arrSource)
    If Not IsArray(arrSource) Then Exit Sub
    If strText = "" Then
        lstListBox.Column = arrSource
    Else
        Dim arrTmp()
        Dim c As Byte, uc As Byte, v As Byte
        Dim r As Long, ur As Long, n As Long
        ur = UBound(arrSource, 2): uc = UBound(arrSource, 1)
        strText = "*" & strText & "*"
        For r = 0 To ur
            For c = 0 To uc
                If arrSource(c, r) Like strText Then
                    ReDim Preserve arrTmp(0 To uc, 0 To n)
                    For v = 0 To uc
                        arrTmp(v, n) = arrSource(v, r)
                    Next
                    n = n + 1
                    Exit For
                End If
            Next
        Next
        If n Then lstListBox.Column = arrTmp Else lstListBox.Clear
    End If
    lstListBox.AddItem Empty
End Sub

Cấu trúc: (Tên thủ tục, Chuỗi cần tìm kiếm, ListBox nhận kết quả, Mảng nguồn)
Mã: 
MultiColumnFilter txtChuoiTK.Text, lstDanhSachVPP, priArrData
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Hoàng Trọng Nghĩa đã viết:
Như đã nói ở bài #1, bài này tôi viết code lại ngắn gọn và chạy nhanh chóng.

1) Thủ tục Format Number trong mảng:

Mã: 
Sub ColFormat(ByVal lstListBox As MSForms.ListBox, ByRef arrSource, ByVal strFormat As String, ParamArray arrColNum())
    Dim dblValue As Double
    Dim r As Long, ur As Long
    Dim c As Byte, uc As Byte
    ur = UBound(arrSource, 2): uc = UBound(arrColNum)
    For r = 0 To ur
        For c = 0 To uc
            dblValue = Val(arrSource(arrColNum(c), r))
            If dblValue = 0 Then
                arrSource(arrColNum(c), r) = 0
            Else
                arrSource(arrColNum(c), r) = Format(dblValue, strFormat)
            End If
        Next
    Next
    lstListBox.Column = arrSource
End Sub

Cấu trúc: (Tên thủ tục ListBox, Mảng cần thay đổi, Cách định dạnh, Các cột cần định dạng)
Mã: 
ColFormat lstDanhSachVPP, priArrData, "#,##0", 4, 5

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

Mã: 
Sub MultiColumnFilter(ByVal strText As String, ByVal lstListBox As MSForms.ListBox, ByVal arrSource)
    If Not IsArray(arrSource) Then Exit Sub
    If strText = "" Then
        lstListBox.Column = arrSource
    Else
        Dim arrTmp()
        Dim c As Byte, uc As Byte, v As Byte
        Dim r As Long, ur As Long, n As Long
        ur = UBound(arrSource, 2): uc = UBound(arrSource, 1)
        strText = "*" & strText & "*"
        For r = 0 To ur
            For c = 0 To uc
                If arrSource(c, r) Like strText Then
                    ReDim Preserve arrTmp(0 To uc, 0 To n)
                    For v = 0 To uc
                        arrTmp(v, n) = arrSource(v, r)
                    Next
                    n = n + 1
                    Exit For
                End If
            Next
        Next
        If n Then lstListBox.Column = arrTmp Else lstListBox.Clear
    End If
    lstListBox.AddItem Empty
End Sub

Cấu trúc: (Tên thủ tục, Chuỗi cần tìm kiếm, ListBox nhận kết quả, Mảng nguồn)
Mã: 
MultiColumnFilter txtChuoiTK.Text, lstDanhSachVPP, priArrData
Nhấp chuột vào đây để mở rộng...
viết thêm chút nữa cho nó co và giản cột theo dữ liệu là hay đấy
1658897457789.png
 
Upvote 0
Upvote 0
Hoàng Trọng Nghĩa đã viết:
Từ bài viết này:

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


Tôi chia sẻ thêm cách lọc nhiều cột bằng ADO (nhưng tôi đánh giá không cao vì tốc độ rất chậm):

PHP: 
Private Sub txtChuoiTK_Change()
    With txtChuoiTK
        If .Text = "" Then
            lstDanhSachVPP.Column = priArrData
        Else
            Dim strSQL As String
            On Error Resume Next
            priObjConnect.Open priStrADO
            strSQL = "SELECT [ID],[MaSP2],[TenSP],[Dvt],Format([GiaGoc],'#,##0'),[MinReorder] FROM [tblDMSP$] " & _
                     "WHERE [ID] LIKE '%" & .Text & "%' OR [MaSP2] LIKE '%" & .Text & "%' OR [TenSP] LIKE '%" & .Text & "%' " & _
                     "OR [Dvt] LIKE '%" & .Text & "%' OR [GiaGoc] LIKE '%" & .Text & "%' OR [MinReorder] LIKE '%" & .Text & "%'"
            priObjRecord.Open strSQL, priObjConnect, 1, 3
            If Not priObjRecord.EOF Then
                lstDanhSachVPP.Column = priObjRecord.GetRows()
            Else
                lstDanhSachVPP.Clear
            End If
            lstDanhSachVPP.AddItem Empty
            priObjRecord.Close
            priObjConnect.Close
        End If
    End With
End Sub
Bài đã được tự động gộp:

Nếu các bạn muốn sắp xếp (sort) theo cột nào thì thêm ORDER BY [tên cột] vào câu lệnh:

Rich (BB code): 
            strSQL = "SELECT [ID],[MaSP2],[TenSP],[Dvt],Format([GiaGoc],'#,##0'),[MinReorder] FROM [tblDMSP$] " & _
                     "WHERE [ID] LIKE '%" & .Text & "%' OR [MaSP2] LIKE '%" & .Text & "%' OR [TenSP] LIKE '%" & .Text & "%' " & _
                     "OR [Dvt] LIKE '%" & .Text & "%' OR [GiaGoc] LIKE '%" & .Text & "%' OR [MinReorder] LIKE '%" & .Text & "%' " & _
                     "ORDER BY [TenSP]"

Nhưng bài #1 này chủ yếu là có thể dùng ADO để lọc nhiều cột, tôi sẽ giới thiệu bài thật sự của tôi về chủ đề này ở bài #2. Nó vẫn có thể chạy mượt mà với 20.000 dòng.
Nhấp chuột vào đây để mở rộng...
Nên xử lý chỗ nhỏ này nữa anh.

1658900678768.png
 
Upvote 0
Upvote 0
Hoàng Trọng Nghĩa đã viết:
Từ bài viết này:

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


Tôi chia sẻ thêm cách lọc nhiều cột bằng ADO (nhưng tôi đánh giá không cao vì tốc độ rất chậm):


Nhưng bài #1 này chủ yếu là có thể dùng ADO để lọc nhiều cột, tôi sẽ giới thiệu thuật toán lọc mới của tôi về chủ đề này ở bài #2. Nó vẫn có thể chạy mượt mà với 20.000 dòng.
Nhấp chuột vào đây để mở rộng...
Bạn Nghĩa nên nói thêm là dùng ADO sẽ phù hợp khi nguồn dữ liệu là từ bên ngoài Excel như Access, SQLLite, My SQL....Khi đó Excel chỉ là Font end để tương tác với người dùng. Nếu gặp trường hợp kết nối qua mạng (LAN, WAN) thì dùng câu lệnh SQL với kết nối ADO sẽ kiểm soát được số lượng dòng, cột, thông tin cần tải về.
 
Upvote 0
Trên nền code có sẳn của @Hoàng Trọng Nghĩa đẹp trai tôi vẻ thêm vài cái Control xong viết thêm ít dòng code + cái DLL của tôi là nó lấy + lọc nhiều CSDL thôi ... ko có gì khó khăn cả ... nay tạm vẻ chút ... rảnh làm tiếp
thong thả câu giờ chơi cho vui thui có đi đâu mà vội

1658907894425.png
 
Upvote 0
Kiều Mạnh đã viết:
Trên nền code có sẳn của @Hoàng Trọng Nghĩa đẹp trai tôi vẻ thêm vài cái Control xong viết thêm ít dòng code + cái DLL của tôi là nó lấy + lọc nhiều CSDL thôi ... ko có gì khó khăn cả ... nay tạm vẻ chút ... rảnh làm tiếp
thong thả câu giờ chơi cho vui thui có đi đâu mà vội

View attachment 279338
Nhấp chuột vào đây để mở rộng...
Anh biết tại sao tôi không dùng SELECT * FROM mà liệt kê tất cả các cột trong file đó ra không?
 
Upvote 0
Kiều Mạnh đã viết:
Trên nền code có sẳn của @Hoàng Trọng Nghĩa đẹp trai tôi vẻ thêm vài cái Control xong viết thêm ít dòng code + cái DLL của tôi là nó lấy + lọc nhiều CSDL thôi ... ko có gì khó khăn cả ... nay tạm vẻ chút ... rảnh làm tiếp
thong thả câu giờ chơi cho vui thui có đi đâu mà vội
Nhấp chuột vào đây để mở rộng...
Cái Form thiết kế dạng này là một phần nhỏ trong ứng dụng người dùng thì thêm Select này nọ vô làm gì? Form hướng dẫn tận răng họ còn thao tác sai thì lấy gì mà tự code câu lệnh SQL.
Cái Dll của bạn nên đưa nó vô một bộ code (class hay module gì cũng được) rồi cung cấp cho người lập trình, họ có thể sử dụng bộ code đó để viết ứng dụng tương tác với các loại CSDL khác nhau. Bộ code gồm các hàm thực hiện các chức năng như: xem, thêm, sửa, xóa, lọc...Cái nào sử dụng chung cho các loại CSDL thì viết chung, cái nào đặc thù thì viết hàm riêng như: gọi View, chạy Store procedure trong SQL Server...
Trên GPE này tôi cũng đã có chia sẻ mấy bài nếu để ý thì sẽ thấy tôi đều dùng chung có 1 bộ code (module) kết nối SQL Server, Access, Foxpro để tương tác dữ liệu thôi đó, khỏi phải viết đi viết lại mất thời gian.

Ví dụ: một số hàm đã dùng trong các bài liên quan kết nối CSDL

CleanShot 2022-07-27 at 15.48.22@2x.jpg

SQL: 
Public Function ExecuteActionQuery(SQLToExecute As String, Optional CloseDatabase As Boolean = True) As Boolean
'//Dung de thuc thi cau lenh Action Query SQL'

    Dim oCmd As Object
    Dim blnReturn As Boolean
    blnReturn = True

    On Error GoTo EAQError

        Set oCmd = CreateObject("ADODB.Command")
        With oCmd
            .CommandType = 1
            Set .ActiveConnection = oConn
            .CommandText = SQLToExecute
            .Prepared = True
            .Execute
        End With
    
    Exit Function

EAQResume:
    On Error Resume Next
    If CloseDatabase Or Not blnReturn Then CloseDB
    ExecuteActionQuery = blnReturn
    Exit Function

EAQError:
    blnReturn = False
    MsgBox "Ma loi: " & Err.Number & vbCrLf & "Noi dung: " & Err.Description, vbCritical + vbSystemModal, "ExecuteActionQuery"
    Resume EAQResume

End Function
 
Lần chỉnh sửa cuối:
Upvote 0
Kiều Mạnh đã viết:
chưa có xem kỹ hình như liên quan tiêu đề + cái name
Nhấp chuột vào đây để mở rộng...
Do cột GiaGoc phải định dạng #,##0 nên mới phải kéo theo các cột kia luôn.
Bài đã được tự động gộp:

Kiều Mạnh đã viết:
ko nói cái đó mà nói ý là thêm co và giản cột vừa với dữ liệu hiện có trên Listbox ấy cho nó đẹp chút thôi
Nhấp chuột vào đây để mở rộng...
Nó co giản cũng không phải khó, nhưng vốn dĩ mình làm biếng làm thôi anh.

 
Upvote 0
ongke0711 đã viết:
Cái Form thiết kế dạng này là một phần nhỏ trong ứng dụng người dùng thì thêm Select này nọ vô làm gì? Form hướng dẫn tận răng họ còn thao tác sai thì lấy gì mà tự code câu lệnh SQL.
Cái Dll của bạn nên đưa nó vô một bộ code (class hay module gì cũng được) rồi cung cấp cho người lập trình, họ có thể sử dụng bộ code đó để viết ứng dụng tương tác với các loại CSDL khác nhau. Bộ code gồm các hàm thực hiện các chức năng như: xem, thêm, sửa, xóa, lọc...Cái nào sử dụng chung cho các loại CSDL thì viết chung, cái nào đặc thù thì viết hàm riêng như: gọi View, chạy Store procedure trong SQL Server...
Trên GPE này tôi cũng đã có chia sẻ mấy bài nếu để ý thì sẽ thấy tôi đều dùng chung có 1 bộ code (module) kết nối SQL Server, Access, Foxpro để tương tác dữ liệu thôi đó, khỏi phải viết đi viết lại mất thời gian.

Ví dụ: một số hàm đã dùng trong các bài liên quan kết nối CSDL

View attachment 279345

SQL: 
Public Function ExecuteActionQuery(SQLToExecute As String, Optional CloseDatabase As Boolean = True) As Boolean
'//Dung de thuc thi cau lenh Action Query SQL'

    Dim oCmd As Object
    Dim blnReturn As Boolean
    blnReturn = True

    On Error GoTo EAQError

        Set oCmd = CreateObject("ADODB.Command")
        With oCmd
            .CommandType = 1
            Set .ActiveConnection = oConn
            .CommandText = SQLToExecute
            .Prepared = True
            .Execute
        End With
   
    Exit Function

EAQResume:
    On Error Resume Next
    If CloseDatabase Or Not blnReturn Then CloseDB
    ExecuteActionQuery = blnReturn
    Exit Function

EAQError:
    blnReturn = False
    MsgBox "Ma loi: " & Err.Number & vbCrLf & "Noi dung: " & Err.Description, vbCritical + vbSystemModal, "ExecuteActionQuery"
    Resume EAQResume

End Function
Nhấp chuột vào đây để mở rộng...
tôi đang nháp thử ra đó xong thử các kiểu xem sao đó thôi ... có gì đâu mà lôi tràng giang đại hải ra thế he

Mai rảnh tôi thử tải cái ListBox với số dòng hiện có trên Excel xem tình hình sao nếu đơ hoặc thoát thì tôi cũng ko quan tâm nữa ... chạy thôi

VD: 1048570 dòng x 12 cột thôi ... xem Listbox có chịu nổi nhiệt hay không ... xong sau đó là tốc độ chạy

Còn vài hàm ADO cổ điển ko có gì đặc biệt thì tôi cũng làm biếng dòm lắm và nay cũng ít quan tâm luôn trừ khi có gì mới đặc biệt thì còn xem học thuật toán ... còn ko làm biếng dòm vì tôi dùng FireDAC của Delphi rồi :p:D
 
Upvote 0
Kiều Mạnh đã viết:
tôi đang nháp thử ra đó xong thử các kiểu xem sao đó thôi ... có gì đâu mà lôi tràng giang đại hải ra thế he

Mai rảnh tôi thử tải cái ListBox với số dòng hiện có trên Excel xem tình hình sao nếu đơ hoặc thoát thì tôi cũng ko quan tâm nữa ... chạy thôi

VD: 1048570 dòng x 12 cột thôi ... xem Listbox có chịu nổi nhiệt hay không ... xong sau đó là tốc độ chạy

Còn vài hàm ADO cổ điển ko có gì đặc biệt thì tôi cũng làm biếng dòm lắm và nay cũng ít quan tâm luôn trừ khi có gì mới đặc biệt thì còn xem học thuật toán ... còn ko làm biếng dòm vì tôi dùng FireDAC của Delphi rồi :p:D
Nhấp chuột vào đây để mở rộng...
:D :D Vậy là bạn cũng chưa hiểu vấn đề của bạn rồi.
Cái tôi nói ở trên chỉ là định hướng của cái thư viện mà bạn khoe bữa giờ, còn viết bằng ngôn ngữ gì là chuyện của bạn. Đi với bụt bận áo cà sa, đi với ma bận áo giấy thôi. Xây dụng ứng dụng trên C#, VB.net thì dùng thư viện đi kèm với nó, Delphi thì dùng của Delphi, thằng VBA thì có thể xài ké các thư viện khác nếu nó chuyển thành COM. Vấn đề là cái DLL viết ra có người tích hợp và xài được với ứng dụng của họ hay không, chứ viết ra mà không ai xài thì có ích gì đâu cho dù nó nhanh nhất, tốt nhất nhưng không ai có nhu cầu với nó thì cũng vứt.
Chẳng hạn như chuyện test Listbox với hơn 1tr dòng để làm gì, để cho biết vậy thôi chứ có ông lập trình nào đi viết cái ứng dụng có cái Listbox tải 1tr dòng???
Còn các hàm ADO chỉ là những hàm UDF để giải quyết một vấn đề nào đó của CSDL, dùng ngôn ngữ nào thì cũng quanh quẩn các giải thuật đó thôi, tùy thư viện mà cách gọi, thực thi câu lệnh SQL khác nhau. SQL server, mySQL thì cũng lòng vòng các câu lệnh SQL: Insert into, Update, Delete...Không có cái nào hiện đại hơn đâu. Chắc là bạn dùng FireDac chạy các câu lệnh SQL khác hiện đại để tương tác với SQL Server chứ không dùng Insert into...cổ điển của nó. Nếu vậy thì bạn giỏi rồi, cứ viết ra bộ thư viện chia sẻ hay bán rồi xem người dùng hay ông lập trình nào tiếp nhận, sử dụng thì biết ngay thôi đó mà. Trình độ Delphi của bạn vậy thì nên tham gia các diễn đàn chuyên về Delphi sẽ có đất dụng võ chứ vô GPE mà gặp mấy anh em như tôi chỉ biết có mỗi VBA, thì khác gì vịt nghe sấm.
Chắc là giờ bạn không còn dòm tới cái VB6 cổ điển mà trước đây bạn đã từng tung hô mãi mãi trường tồn nữa rồi đúng không! :D
 
Lần chỉnh sửa cuối:
Upvote 0
ongke0711 đã viết:
Trình độ Delphi của bạn vậy thì nên tham gia các diễn đàn chuyên về Delphi sẽ có đất dụng võ chứ vô GPE mà gặp mấy anh em như tôi chỉ biết có mỗi VBA, thì khác gì vịt nghe sấm.
Nhấp chuột vào đây để mở rộng...
Tham gia diễn đàn Excel thì còn khoe được mấy cái cóp nhặt được chứ mang lên diễn đàn Delphi có khi người ta lại cười cho. Mà khoe trên diễn đàn Delphi là phải khoe code chứ có phải chỉ khoe DLL lòe người khác như trên diễn đàn Excel đâu. Tôi không nói tới riêng ai cả, không nói tới người cụ thể. Có thể là nói cả tới những người như tôi.
 
Upvote 0
Hoàng Trọng Nghĩa đã viết:
2) Thủ tục lọc nhiều cột:

Mã: 
Sub MultiColumnFilter(ByVal strText As String, ByVal lstListBox As MSForms.ListBox, ByVal arrSource)
    If Not IsArray(arrSource) Then Exit Sub
    If strText = "" Then
        lstListBox.Column = arrSource
    Else
        Dim arrTmp()
        Dim c As Byte, uc As Byte, v As Byte
        Dim r As Long, ur As Long, n As Long
        ur = UBound(arrSource, 2): uc = UBound(arrSource, 1)
        strText = "*" & strText & "*"
        For r = 0 To ur
            For c = 0 To uc
                If arrSource(c, r) Like strText Then
                    ReDim Preserve arrTmp(0 To uc, 0 To n)
                    For v = 0 To uc
                        arrTmp(v, n) = arrSource(v, r)
                    Next
                    n = n + 1
                    Exit For
                End If
            Next
        Next
        If n Then lstListBox.Column = arrTmp Else lstListBox.Clear
    End If
    lstListBox.AddItem Empty
End Sub

Cấu trúc: (Tên thủ tục, Chuỗi cần tìm kiếm, ListBox nhận kết quả, Mảng nguồn)
Mã: 
MultiColumnFilter txtChuoiTK.Text, lstDanhSachVPP, priArrData
Nhấp chuột vào đây để mở rộng...
Từ bài trên, tôi cải tiến nó lại linh hoạt là chúng ta cần lọc cột nào, một hay nhiều cột hay lọc tất cả các cột cho nó đỡ phí thời gian, code như sau:
Mã: 
Sub MultiColumnFilter(ByVal strText As String, ByVal lstListBox As MSForms.ListBox, ByVal arrSource, ParamArray arrColNum())
    If Not IsArray(arrSource) Then Exit Sub
    If strText = "" Then
        lstListBox.Column = arrSource
    Else
        Dim arrTmp()
        Dim c As Byte, uc As Byte, v As Byte
        Dim r As Long, ur As Long, n As Long
        ur = UBound(arrSource, 2): uc = UBound(arrSource, 1)
        strText = "*" & strText & "*"
        If LCase(arrColNum(0)) = "all" Then
            For r = 0 To ur
                For c = 0 To uc
                    If arrSource(c, r) Like strText Then
                        ReDim Preserve arrTmp(0 To uc, 0 To n)
                        For v = 0 To uc
                            arrTmp(v, n) = arrSource(v, r)
                        Next
                        n = n + 1
                        Exit For
                    End If
                Next
            Next
        Else
            Dim u As Byte
            u = UBound(arrColNum)
            For r = 0 To ur
                For c = 0 To u
                    If arrSource(arrColNum(c), r) Like strText Then
                        ReDim Preserve arrTmp(0 To uc, 0 To n)
                        For v = 0 To uc
                            arrTmp(v, n) = arrSource(v, r)
                        Next
                        n = n + 1
                        Exit For
                    End If
                Next
            Next
        End If
        If n Then lstListBox.Column = arrTmp Else lstListBox.Clear
    End If
    lstListBox.AddItem Empty
End Sub

Khi đó, nếu muốn cột nào cũng lọc thì cấu trúc như sau:
Rich (BB code): 
MultiColumnFilter txtChuoiTK.Text, lstDanhSachVPP, priArrData, "all"
Muốn chỉ lọc 2 cột:
Rich (BB code): 
MultiColumnFilter txtChuoiTK.Text, lstDanhSachVPP, priArrData, 1, 2
Lọc 1 cột duy nhất:
Rich (BB code): 
MultiColumnFilter txtChuoiTK.Text, lstDanhSachVPP, priArrData, 2

Lưu ý: Mảng của tôi thiết kế là mảng bắt đầu từ số 0 (kể cả chiều ngang lẫn chiều dọc), vì thế chọn cột nếu chọn cột 1 thì ghi là 0 nhé, tương tự với các cột khác.
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Không biết có đúng chủ đề này không nhưng tôi đọc qua thấy dính dáng tới lọc nhiều cột ListBox.

Tôi viết gần 2,5 năm trước - Sub FindMultiCol_to_ListBox, bài #6

www.giaiphapexcel.com

Hỏi về cách lọc dữ liệu và sau đó trích xuất dữ liệu ra sheet khác!

Em có file như đính kèm, và có 1 vài mong muốn được trợ giúp: 1. Ở sheet VBA: Cách tìm kiếm dữ liệu trên 2 hoặc nhiều cột 1 lúc, em đã làm bằng cách chạy form và sử dụng hàm BS_functions của A-Toll bản free (giới hạn tìm được là 200 dòng dữ liệu). Nhưng nếu không sử dụng hàm của A-Tool mà chạy...
www.giaiphapexcel.com www.giaiphapexcel.com
 
Upvote 0
Upvote 0
Hoàng Trọng Nghĩa đã viết:
Như đã nói ở bài #1, bài này tôi viết code lại ngắn gọn và chạy nhanh chóng.

1) Thủ tục Format Number trong mảng:

Mã: 
Sub ColFormat(ByVal lstListBox As MSForms.ListBox, ByRef arrSource, ByVal strFormat As String, ParamArray arrColNum())
    Dim dblValue As Double
    Dim r As Long, ur As Long
    Dim c As Byte, uc As Byte
    ur = UBound(arrSource, 2): uc = UBound(arrColNum)
    For r = 0 To ur
        For c = 0 To uc
            dblValue = Val(arrSource(arrColNum(c), r))
            If dblValue = 0 Then
                arrSource(arrColNum(c), r) = 0
            Else
                arrSource(arrColNum(c), r) = Format(dblValue, strFormat)
            End If
        Next
    Next
    lstListBox.Column = arrSource
End Sub

Cấu trúc: (Tên thủ tục ListBox, Mảng cần thay đổi, Cách định dạnh, Các cột cần định dạng)
Mã: 
ColFormat lstDanhSachVPP, priArrData, "#,##0", 4, 5

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

Mã: 
Sub MultiColumnFilter(ByVal strText As String, ByVal lstListBox As MSForms.ListBox, ByVal arrSource)
    If Not IsArray(arrSource) Then Exit Sub
    If strText = "" Then
        lstListBox.Column = arrSource
    Else
        Dim arrTmp()
        Dim c As Byte, uc As Byte, v As Byte
        Dim r As Long, ur As Long, n As Long
        ur = UBound(arrSource, 2): uc = UBound(arrSource, 1)
        strText = "*" & strText & "*"
        For r = 0 To ur
            For c = 0 To uc
                If arrSource(c, r) Like strText Then
                    ReDim Preserve arrTmp(0 To uc, 0 To n)
                    For v = 0 To uc
                        arrTmp(v, n) = arrSource(v, r)
                    Next
                    n = n + 1
                    Exit For
                End If
            Next
        Next
        If n Then lstListBox.Column = arrTmp Else lstListBox.Clear
    End If
    lstListBox.AddItem Empty
End Sub

Cấu trúc: (Tên thủ tục, Chuỗi cần tìm kiếm, ListBox nhận kết quả, Mảng nguồn)
Mã: 
MultiColumnFilter txtChuoiTK.Text, lstDanhSachVPP, priArrData
Nhấp chuột vào đây để mở rộng...
Em thấy code này rất hay, nhưng trường hợp của em cần lấy danh sách từ 2 sheet để đưa vào listbox. nhờ anh giúp em với ạ, em cảm ơn anh.
 
Upvote 0
Hoàng Trọng Nghĩa đã viết:
Từ bài trên, tôi cải tiến nó lại linh hoạt là chúng ta cần lọc cột nào, một hay nhiều cột hay lọc tất cả các cột cho nó đỡ phí thời gian, code như sau:
Mã: 
Sub MultiColumnFilter(ByVal strText As String, ByVal lstListBox As MSForms.ListBox, ByVal arrSource, ParamArray arrColNum())
    If Not IsArray(arrSource) Then Exit Sub
    If strText = "" Then
        lstListBox.Column = arrSource
    Else
        Dim arrTmp()
        Dim c As Byte, uc As Byte, v As Byte
        Dim r As Long, ur As Long, n As Long
        ur = UBound(arrSource, 2): uc = UBound(arrSource, 1)
        strText = "*" & strText & "*"
        If LCase(arrColNum(0)) = "all" Then
            For r = 0 To ur
                For c = 0 To uc
                    If arrSource(c, r) Like strText Then
                        ReDim Preserve arrTmp(0 To uc, 0 To n)
                        For v = 0 To uc
                            arrTmp(v, n) = arrSource(v, r)
                        Next
                        n = n + 1
                        Exit For
                    End If
                Next
            Next
        Else
            Dim u As Byte
            u = UBound(arrColNum)
            For r = 0 To ur
                For c = 0 To u
                    If arrSource(arrColNum(c), r) Like strText Then
                        ReDim Preserve arrTmp(0 To uc, 0 To n)
                        For v = 0 To uc
                            arrTmp(v, n) = arrSource(v, r)
                        Next
                        n = n + 1
                        Exit For
                    End If
                Next
            Next
        End If
        If n Then lstListBox.Column = arrTmp Else lstListBox.Clear
    End If
    lstListBox.AddItem Empty
End Sub

Khi đó, nếu muốn cột nào cũng lọc thì cấu trúc như sau:
Rich (BB code): 
MultiColumnFilter txtChuoiTK.Text, lstDanhSachVPP, priArrData, "all"
Muốn chỉ lọc 2 cột:
Rich (BB code): 
MultiColumnFilter txtChuoiTK.Text, lstDanhSachVPP, priArrData, 1, 2
Lọc 1 cột duy nhất:
Rich (BB code): 
MultiColumnFilter txtChuoiTK.Text, lstDanhSachVPP, priArrData, 2

Lưu ý: Mảng của tôi thiết kế là mảng bắt đầu từ số 0 (kể cả chiều ngang lẫn chiều dọc), vì thế chọn cột nếu chọn cột 1 thì ghi là 0 nhé, tương tự với các cột khác.
Nhấp chuột vào đây để mở rộng...
Nhờ anh Nghĩa xem giúp với, nếu danh sách có 2 cột thì bị lỗi anh ạ.
Nếu sửa:
If arrSource(arrColNum(c), r) Like strText Then
Thành:
If arrSource(arrColNum(c) - 1, r) Like strText Then
Thì không còn lỗi nữa anh.
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Hoàng Nhật Phương đã viết:
Nhờ anh Nghĩa xem giúp với, nếu danh sách có 2 cột thì bị lỗi anh ạ.
Nếu sửa:
If arrSource(arrColNum(c), r) Like strText Then
Thành:
If arrSource(arrColNum(c) - 1, r) Like strText Then
Thì không còn lỗi nữa anh.
Nhấp chuột vào đây để mở rộng...
Ủa, tự sửa hết lỗi rồi, đem lên đây hỏi làm gì trời? Code là để phục vụ cho mình, nếu nó thực hiện đúng ý đồ của mình rồi thì thắc mắc chi nữa???
 
Upvote 0
Hoàng Trọng Nghĩa đã viết:
Ủa, tự sửa hết lỗi rồi, đem lên đây hỏi làm gì trời? Code là để phục vụ cho mình, nếu nó thực hiện đúng ý đồ của mình rồi thì thắc mắc chi nữa???
Nhấp chuột vào đây để mở rộng...
à hỏi xong thì OT mới biết sửa anh Nghĩa, như vậy OT sửa đúng rồi anh nhỉ ... hihi
Cảm ơn anh Nghĩa đẹp trai nhé ^^
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

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

H
  • Question Question
Code Sổ Chi Tiết Tài Khoản (3 người xem)
Trả lời
4
Đọc
101
hieuvietmy2020
H
thanhss
Nhờ tìm công thức tính tổng theo hàng có kèm dữ liệu Text (5 người xem)
Trả lời
2
Đọc
10
thanhss
thanhss
befaint
Chia sẻ tâm tư, xả nỗi lòng (1 người xem)
    • Thích
6 7 8
Trả lời
776
Đọc
72K
anhtuanle123
A
H
File excel bị lỗi không mở được
Trả lời
6
Đọc
45
hiep204
H
Nguyễn Duy Tuân
[New] BSAC v3.0 bộ công cụ lập trình phần mềm chuyên nghiệp trong VBA (1 người xem)
    • Thích
Trả lời
10
Đọc
3K
Nguyễn Duy Tuân
Nguyễn Duy Tuân
A
  • Question Question
Sửa code VBA nhập liệu userform (1 người xem)
Trả lời
24
Đọc
978
ongke0711
ongke0711
SA_DQ
Copilot & bài thơ chia bánh do 'Hắn' sáng tác
Trả lời
2
Đọc
60
SA_DQ
SA_DQ
HeSanbi
  • Đã giải quyết
WeatherXL - Ứng dụng lấy dữ liệu Thời tiết siêu nhanh (***Nguồn cấp FreeMeteo đã dừng cấp dữ liệu lịch sử)
    • Thích
    • Yêu thích
Trả lời
90
Đọc
25K
dinhhoangcd13
D
T
GẤP: TÌM GIÁ THEO TỪNG KHÁCH
Trả lời
7
Đọc
334
tulipviet
T
D
lấy thẻ kho từ sổ kho nên dùng hàm nào ah
Trả lời
3
Đọc
82
dankedun
D
L
công thứ tìm giá trị giao hàng với cột (1 người xem)
Trả lời
13
Đọc
197
luongcongdua
L
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (5 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
4 5 6
Trả lời
552
Đọc
70K
ongke0711
ongke0711
K
Nhờ anh chị làm công thức lọc dữ kiện ngày từ bảng 1 sang rút gọn ngày ở bảng 2.
Trả lời
1
Đọc
107
thanthanhan
thanthanhan
SA_DQ
Tìm số chính phương trong 1 biểu thức cho trước
    • Thích
    • Yêu thích
Trả lời
22
Đọc
355
dungpham01
D
T
TỈNH TỔNG TỪNG Ô THEO ĐIỀU KIỆN
Trả lời
3
Đọc
122
thanthanhan
thanthanhan
8
Tính tổng điểm 3 môn theo tổ hợp xét tuyển
Trả lời
3
Đọc
96
ptm0412
ptm0412
N
  • Question Question
Tool chia băng kết hợp bên ngành tôn
Trả lời
0
Đọc
96
nguyenanhtruong2409
N
S
Chỉnh công thức tính tỷ lệ hoàn thành giúp mình với. (1 người xem)
Trả lời
8
Đọc
468
ptm0412
ptm0412
L
Tìm giải pháp trừ lùi nguyên liệu xuất nhập khẩu
Trả lời
9
Đọc
312
luongcongdua
L
2
  • Question Question
Hỏi cách in phiếu điều tra PCGD-XMC từ file dữ liệu mẫu xuất ra từ hệ thống PCGD-XMC của Bộ GD (1 người xem)
    • Thích
Trả lời
31
Đọc
2K
Hoàng Tuấn 868
H
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Thời gian đếm ngược.

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom