Tạo ô tìm kiếm có gợi ý như google

[phuthinhpthv]

Mình có xem trên mạng và làm theo nhưng bị lỗi không ra được ở phân đoạn cuối. Mong mọi người giúp mình ạ. Mình cảm ơn!

 

[hunglam123]

Mình có xem trên mạng và làm theo nhưng bị lỗi không ra được ở phân đoạn cuối. Mong mọi người giúp mình ạ. Mình cảm ơn!

Dùng code lọc thôi đơn giản mà
tạo 1 form gom 1 textbox và 1 list box , áp code này vào là lụm lúa

Option Explicit



'Function tim dong cuoi

Function DongCuoi(Ws As Worksheet, Col As Variant) As Long

    DongCuoi = Ws.Cells(Rows.Count, Col).End(xlUp).Row

End Function



'Function TimKiem tra ve mang

Function TimKiem(Rng As Range, Str As String) As Variant

    Dim Arr As Variant, Tam As Variant, i As Long, _

        Strs As String, k As Long, c As Byte, j As Byte, KQ As Variant

    Arr = Rng.Value

    ReDim Tam(1 To UBound(Arr, 1), 1 To UBound(Arr, 2))

    For i = 1 To UBound(Arr, 1)

        Strs = ""

        For j = 1 To UBound(Arr, 2)

            Strs = Strs & Arr(i, j)

        Next j

        If InStr(1, Trim(LCase(Strs)), Trim(LCase(Str)), vbTextCompare) > 0 Then

            k = k + 1

            For c = 1 To UBound(Arr, 2)

                Tam(k, c) = Arr(i, c)

            Next c

        End If

    Next i

  

    If k > 0 Then

        ReDim KQ(1 To k, 1 To UBound(Arr, 2))

        For i = 1 To k

            For j = 1 To UBound(Tam, 2)

                KQ(i, j) = Tam(i, j)

            Next j

        Next i

        TimKiem = KQ

    End If

End Function



Private Sub LisKQ_Click()



End Sub



'Khi go

Private Sub txtSearch_Change()

    LisKQ.Clear

    Dim Arr As Variant, Lr As Long, Rng As Range

    Lr = DongCuoi(Sheet1, 1)

    Set Rng = Sheet1.Range("A4:I" & Lr)

    Arr = TimKiem(Rng, txtSearch.Value)

    Set Rng = Nothing

    If Not IsEmpty(Arr) Then

        LisKQ.List = Arr

        Erase Arr

    End If

End Sub



'Khi mo UF_HH

Private Sub UserForm_Initialize()

    Dim Lr As Long

    Lr = DongCuoi(Sheet1, 1)

    With LisKQ

        .ColumnCount = 9

        .ColumnHeads = True

        .List = Sheet1.Range("A3:I" & Lr).Value

    End With

End Sub

 

[anhtuan2939]

Mình có xem trên mạng và làm theo nhưng bị lỗi không ra được ở phân đoạn cuối

Sao bạn không gửi file bạn làm theo trên mạng lên, để xem bạn làm như thế nào, sai ở đâu thì người khác còn biết giúp bạn sửa.

 

[phuthinhpthv]

Sao bạn không gửi file bạn làm theo trên mạng lên, để xem bạn làm như thế nào, sai ở đâu thì người khác còn biết giúp bạn sửa.

Bài đã được tự động gộp: 28/6/20

Thanks bạn, cái công thức đó mình xem trên clip

Dùng code lọc thôi đơn giản mà
tạo 1 form gom 1 textbox và 1 list box , áp code này vào là lụm lúa

Option Explicit



'Function tim dong cuoi

Function DongCuoi(Ws As Worksheet, Col As Variant) As Long

    DongCuoi = Ws.Cells(Rows.Count, Col).End(xlUp).Row

End Function



'Function TimKiem tra ve mang

Function TimKiem(Rng As Range, Str As String) As Variant

    Dim Arr As Variant, Tam As Variant, i As Long, _

        Strs As String, k As Long, c As Byte, j As Byte, KQ As Variant

    Arr = Rng.Value

    ReDim Tam(1 To UBound(Arr, 1), 1 To UBound(Arr, 2))

    For i = 1 To UBound(Arr, 1)

        Strs = ""

        For j = 1 To UBound(Arr, 2)

            Strs = Strs & Arr(i, j)

        Next j

        If InStr(1, Trim(LCase(Strs)), Trim(LCase(Str)), vbTextCompare) > 0 Then

            k = k + 1

            For c = 1 To UBound(Arr, 2)

                Tam(k, c) = Arr(i, c)

            Next c

        End If

    Next i

 

    If k > 0 Then

        ReDim KQ(1 To k, 1 To UBound(Arr, 2))

        For i = 1 To k

            For j = 1 To UBound(Tam, 2)

                KQ(i, j) = Tam(i, j)

            Next j

        Next i

        TimKiem = KQ

    End If

End Function



Private Sub LisKQ_Click()



End Sub



'Khi go

Private Sub txtSearch_Change()

    LisKQ.Clear

    Dim Arr As Variant, Lr As Long, Rng As Range

    Lr = DongCuoi(Sheet1, 1)

    Set Rng = Sheet1.Range("A4:I" & Lr)

    Arr = TimKiem(Rng, txtSearch.Value)

    Set Rng = Nothing

    If Not IsEmpty(Arr) Then

        LisKQ.List = Arr

        Erase Arr

    End If

End Sub



'Khi mo UF_HH

Private Sub UserForm_Initialize()

    Dim Lr As Long

    Lr = DongCuoi(Sheet1, 1)

    With LisKQ

        .ColumnCount = 9

        .ColumnHeads = True

        .List = Sheet1.Range("A3:I" & Lr).Value

    End With

End Sub

Cảm ơn bạn! Cái này cao siêu quá mình chưa biết.

Bài đã được tự động gộp: 28/6/20

Sao bạn không gửi file bạn làm theo trên mạng lên, để xem bạn làm như thế nào, sai ở đâu thì người khác còn biết giúp bạn sửa.

mình xem trên clip, nặng quá ko gửi lên được ạ