Tìm kiếm với Code với combobox

Yeuvoyeucon · 18/8/21

Kính gửi anh chị và các bạn
Em muốn tìm kiếm theo tên hàng. Và khi gõ ký tự thì các tên hàng chứa ký tự đó đều hiện lên hết không phân biệt ở đầu hay ở giữa hay bất kỳ thì làm sao tiếp ạ (Ví dụ gõ ký tự Gi thì sẽ hiện Mien Giong Cu Gieng và My Tom Gio
Em mò trên mạng mà mới làm được thế này ạ. Nhờ GPE trợ giúp ạ.

Ngày mai trời lại sáng · 18/8/21

Yeuvoyeucon đã viết:
Kính gửi anh chị và các bạn
Em muốn tìm kiếm theo tên hàng. Và khi gõ ký tự thì các tên hàng chứa ký tự đó đều hiện lên hết không phân biệt ở đầu hay ở giữa hay bất kỳ thì làm sao tiếp ạ (Ví dụ gõ ký tự Gi thì sẽ hiện Mien Giong Cu Gieng và My Tom Gio
Em mò trên mạng mà mới làm được thế này ạ. Nhờ GPE trợ giúp ạ.

Giống video này bạn nhỉ

Liên kết: https://www.youtube.com/watch?v=6ckANTT1eFU

BuiQuangThuan · 18/8/21

Yeuvoyeucon đã viết:
Kính gửi anh chị và các bạn
Em muốn tìm kiếm theo tên hàng. Và khi gõ ký tự thì các tên hàng chứa ký tự đó đều hiện lên hết không phân biệt ở đầu hay ở giữa hay bất kỳ thì làm sao tiếp ạ (Ví dụ gõ ký tự Gi thì sẽ hiện Mien Giong Cu Gieng và My Tom Gio
Em mò trên mạng mà mới làm được thế này ạ. Nhờ GPE trợ giúp ạ.

Mã:

Private Sub ComboBox1_Change()
    With Me.ComboBox1
    Dim irow&
        irow = Sheet1.Range("A" & Rows.Count).End(3).Row
        '.List = Worksheets("Sheet1").Range("A2:B" & Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp)).Value
        '  .ListRows = Application.WorksheetFunction.Min(5, .ListCount)
        '.DropDown
        ' If ListRowsMaximum = 0 Then ListRowsMaximum = Me.ComboBox1.ListRows
    Dim arr(), Res()
        arr = Sheet1.Range("A2:B" & irow).Value
        ReDim Res(1 To UBound(arr, 1), 1 To 1)
        For i = 1 To UBound(arr, 1)
            If arr(i, 2) Like "*" & .Text & "*" Then
                k = k + 1
                Res(k, 1) = arr(i, 2)
            End If
        Next
        .List = Res
        .DropDown
    End With
End Sub

Thử

Yeuvoyeucon · 18/8/21

buiquangthuan đã viết:

Mã:

Private Sub ComboBox1_Change()
    With Me.ComboBox1
    Dim irow&
        irow = Sheet1.Range("A" & Rows.Count).End(3).Row
        '.List = Worksheets("Sheet1").Range("A2:B" & Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp)).Value
        '  .ListRows = Application.WorksheetFunction.Min(5, .ListCount)
        '.DropDown
        ' If ListRowsMaximum = 0 Then ListRowsMaximum = Me.ComboBox1.ListRows
    Dim arr(), Res()
        arr = Sheet1.Range("A2:B" & irow).Value
        ReDim Res(1 To UBound(arr, 1), 1 To 1)
        For i = 1 To UBound(arr, 1)
            If arr(i, 2) Like "*" & .Text & "*" Then
                k = k + 1
                Res(k, 1) = arr(i, 2)
            End If
        Next
        .List = Res
        .DropDown
    End With
End Sub

Thử

Em cảm ơn anh ạ !

Hoàng Trọng Nghĩa · 18/8/21

buiquangthuan đã viết:

Mã:

Private Sub ComboBox1_Change()
    With Me.ComboBox1
    Dim irow&
        irow = Sheet1.Range("A" & Rows.Count).End(3).Row
        '.List = Worksheets("Sheet1").Range("A2:B" & Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp)).Value
        '  .ListRows = Application.WorksheetFunction.Min(5, .ListCount)
        '.DropDown
        ' If ListRowsMaximum = 0 Then ListRowsMaximum = Me.ComboBox1.ListRows
    Dim arr(), Res()
        arr = Sheet1.Range("A2:B" & irow).Value
        ReDim Res(1 To UBound(arr, 1), 1 To 1)
        For i = 1 To UBound(arr, 1)
            If arr(i, 2) Like "*" & .Text & "*" Then
                k = k + 1
                Res(k, 1) = arr(i, 2)
            End If
        Next
        .List = Res
        .DropDown
    End With
End Sub

Thử

Một điều hết sức chú ý khi lọc trên ComboBox, nếu không bỏ thuộc tính này thì khó lọc chính xác được những thứ mình mong muốn.
Trong trường hợp trong hình dưới đây, tôi mới gõ chữ N thì ComboBox nó đã "tài lanh" điền đầy đủ item mà nó gần nhất có chứa ký tự đầu.

vanthinh3101 · 18/8/21

Theo lời bác @Hoàng Trọng Nghĩa, phải làm 2 bước:
- Bước 1: cài đặt Combox như hình
- Bước 2: tôi có sửa lại code của bạn @buiquangthuan ở bài #3 một chút

PHP:

Private Sub ComboBox1_Change()
    With Me.ComboBox1
    Dim irow As Integer
        irow = Sheet1.Range("A" & Rows.Count).End(3).Row
        '.List = Worksheets("Sheet1").Range("A2:B" & Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp)).Value
        '  .ListRows = Application.WorksheetFunction.Min(5, .ListCount)
        '.DropDown
        ' If ListRowsMaximum = 0 Then ListRowsMaximum = Me.ComboBox1.ListRows
    Dim arr(), Res()
        arr = Sheet1.Range("A2:B" & irow).Value
       
        For i = 1 To UBound(arr, 1)
            'If arr(i, 2) Like "*" & .Text & "*" Then
            If InStr(1, UCase(arr(i, 2)), UCase(.Text)) > 0 Then
                k = k + 1: ReDim Preserve Res(1 To k)
                Res(k) = arr(i, 2)
            End If
        Next
        .List = Res
        .DropDown
    End With
End Sub

nguyenthuy13388 · 18/8/21

Yeuvoyeucon đã viết:
Kính gửi anh chị và các bạn
Em muốn tìm kiếm theo tên hàng. Và khi gõ ký tự thì các tên hàng chứa ký tự đó đều hiện lên hết không phân biệt ở đầu hay ở giữa hay bất kỳ thì làm sao tiếp ạ (Ví dụ gõ ký tự Gi thì sẽ hiện Mien Giong Cu Gieng và My Tom Gio
Em mò trên mạng mà mới làm được thế này ạ. Nhờ GPE trợ giúp ạ.

Bạn thử code dưới đây xem có đúng không?

Mã:

Private Sub ComboBox1_Change()
Dim Lr&, Str$
Dim Rng As Range
Dim Arr(1 To 100, 1 To 2), k&, khoa$

Str = ComboBox1.Value
With Sheets("Sheet11")
    Lr = .Range("A10000").End(xlUp).Row
    Set Rng = .Range("A2:B" & Lr).Find(What:=Str, LookIn:=xlFormulas2, LookAt:=xlPart)
    If Not Rng Is Nothing Then
        khoa = Rng.Address
        Do
            k = k + 1
            Arr(k, 1) = .Range("A" & Rng.Row).Value
            Arr(k, 2) = .Range("B" & Rng.Row).Value
            Set Rng = .Range("A2:B" & Lr).FindNext(Rng)
        Loop Until Rng.Address = khoa
    End If
End With
If k > 0 Then
    With Me.ComboBox1
        .ColumnWidths = "50;100"
        .ListRows = k
        .List = Arr
        .Activate
        .DropDown
    End With
End If
End Sub

be_09 · 19/8/21

Yeuvoyeucon đã viết:
Kính gửi anh chị và các bạn
Em muốn tìm kiếm theo tên hàng. Và khi gõ ký tự thì các tên hàng chứa ký tự đó đều hiện lên hết không phân biệt ở đầu hay ở giữa hay bất kỳ thì làm sao tiếp ạ (Ví dụ gõ ký tự Gi thì sẽ hiện Mien Giong Cu Gieng và My Tom Gio
Em mò trên mạng mà mới làm được thế này ạ. Nhờ GPE trợ giúp ạ.

Thử sử dụng File, chỉ với 1 dòng code.

HUONGHCKT · 19/8/21

vanthinh3101 đã viết:

Theo lời bác @Hoàng Trọng Nghĩa, phải làm 2 bước:
- Bước 1: cài đặt Combox như hình
- Bước 2: tôi có sửa lại code của bạn @buiquangthuan ở bài #3 một chút

PHP:

Private Sub ComboBox1_Change()
    With Me.ComboBox1
    Dim irow As Integer
        irow = Sheet1.Range("A" & Rows.Count).End(3).Row
        '.List = Worksheets("Sheet1").Range("A2:B" & Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp)).Value
        '  .ListRows = Application.WorksheetFunction.Min(5, .ListCount)
        '.DropDown
        ' If ListRowsMaximum = 0 Then ListRowsMaximum = Me.ComboBox1.ListRows
    Dim arr(), Res()
        arr = Sheet1.Range("A2:B" & irow).Value
      
        For i = 1 To UBound(arr, 1)
            'If arr(i, 2) Like "*" & .Text & "*" Then
            If InStr(1, UCase(arr(i, 2)), UCase(.Text)) > 0 Then
                k = k + 1: ReDim Preserve Res(1 To k)
                Res(k) = arr(i, 2)
            End If
        Next
        .List = Res
        .DropDown
    End With
End Sub

View attachment 264295

Không hiểu tại sao chạy thấy báo lỗi ở dòng .List=Res ;
Vẫn code cũ sửa lại một chút chạy ngon lành:

Mã:

Private Sub ComboBox1_Change()
    With Me.ComboBox1
    Dim irow As Integer
        irow = Sheet1.Range("A" & Rows.Count).End(3).Row
        '.List = Worksheets("Sheet1").Range("A2:B" & Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp)).Value
        '  .ListRows = Application.WorksheetFunction.Min(5, .ListCount)
        '.DropDown
        ' If ListRowsMaximum = 0 Then ListRowsMaximum = Me.ComboBox1.ListRows
    Dim arr(), Res()
        arr = Sheet1.Range("A2:B" & irow).Value
       ReDim Res(1 To UBound(arr), 1 To 1)
        For i = 1 To UBound(arr, 1)
            If arr(i, 2) Like "*" & .Text & "*" Then
            'If InStr(1, UCase(arr(i, 2)), UCase(.Text)) > 0 Then
                k = k + 1
                Res(k, 1) = arr(i, 2)
            End If
        Next
        .List = Res
        .DropDown
    End With
End Sub

vanthinh3101 · 19/8/21

HUONGHCKT đã viết:

Không hiểu tại sao chạy thấy báo lỗi ở dòng .List=Res ;
Vẫn code cũ sửa lại một chút chạy ngon lành:

Mã:

Private Sub ComboBox1_Change()
    With Me.ComboBox1
    Dim irow As Integer
        irow = Sheet1.Range("A" & Rows.Count).End(3).Row
        '.List = Worksheets("Sheet1").Range("A2:B" & Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp)).Value
        '  .ListRows = Application.WorksheetFunction.Min(5, .ListCount)
        '.DropDown
        ' If ListRowsMaximum = 0 Then ListRowsMaximum = Me.ComboBox1.ListRows
    Dim arr(), Res()
        arr = Sheet1.Range("A2:B" & irow).Value
       ReDim Res(1 To UBound(arr), 1 To 1)
        For i = 1 To UBound(arr, 1)
            If arr(i, 2) Like "*" & .Text & "*" Then
            'If InStr(1, UCase(arr(i, 2)), UCase(.Text)) > 0 Then
                k = k + 1
                Res(k, 1) = arr(i, 2)
            End If
        Next
        .List = Res
        .DropDown
    End With
End Sub

Lỗi là khi bạn đưa vào 1 ký tự không tồn tại trong các từ ở danh sách kia.
Bạn thử đánh z, 0-9 sẽ báo lỗi vì lúc đó k=0 --> Res() chưa có gì
Để khắc phục thì bạn thêm điều kiện kiểm tra k là được:

PHP:

If k Then
    .List = Res
    .DropDown
End If

Code của bạn sẽ nảy sinh vấn đề: xác định kích thước mảng Res dựa trên arr:
- Trường hợp k < ubound(arr), mảng Res() ngoài các kết quả đúng, vẫn có các giá trị không đúng (các phần tử chưa được gán giá trị - khoảng trắng)
- Trường hợp không có giá trị thỏa mãn, mảng Res() vẫn tồn tại và gồm toàn các giá trị không đúng.

ptm0412 · 19/8/21

be_09 đã viết:
Thử sử dụng File, chỉ với 1 dòng code.

Tác giả dùng combobox và muốn kết quả anh lọc trên sheet trở thành list mới của combobox đó anh. Một dòng code chỉ làm được 1 việc lọc thôi.

be_09 · 19/8/21

ptm0412 đã viết:
Tác giả dùng combobox và muốn kết quả anh lọc trên sheet trở thành list mới của combobox đó anh. Một dòng code chỉ làm được 1 việc lọc thôi.

1/ Bài 1 chủ Topic diễn giải không rõ ràng, lại không nêu mục đích để làm gì? Họ hỏi đến đâu thì làm đến đấy.
2/ Nếu chủ Topic nêu cụ thể nội dung như bài 2 thì mới góp ý cho họ sử dụng UserForm để tra cứu và nhập liệu vào hóa đơn hoặc báo giá đơn hàng sẽ thuận tiện và nhanh hơn nhiều.

ptm0412 · 19/8/21

be_09 đã viết:
1/ Bài 1 chủ Topic diễn giải không rõ ràng, lại không nêu mục đích để làm gì? Họ hỏi đến đâu thì làm đến đấy.
2/ Nếu chủ Topic nêu cụ thể nội dung như bài 2 thì mới góp ý cho họ sử dụng UserForm để tra cứu và nhập liệu vào hóa đơn hoặc báo giá đơn hàng sẽ thuận tiện và nhanh hơn nhiều.

Tiêu đề, nội dung và cả file mẫu bài 1 đều là combobox mà anh.

Tìm kiếm với Code với combobox

Yeuvoyeucon

Thành viên hoạt động

File đính kèm

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

Thành viên thường trực

BuiQuangThuan

❆❆❆❆❆❆❆❆❆❆❆❆

Yeuvoyeucon

Thành viên hoạt động

Hoàng Trọng Nghĩa

Chuyên gia GPE

vanthinh3101

Thành viên tích cực

nguyenthuy13388

Thành viên thường trực

be_09

Biên Hòa, Đồng Nai

File đính kèm

HUONGHCKT

Zalo 0986997214

vanthinh3101

Thành viên tích cực

ptm0412

Bad Excel Member

be_09

Biên Hòa, Đồng Nai

ptm0412

Bad Excel Member

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

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