Xóa Dòng Trống Khi Tìm Kiếm Trong ListBox VBA Excel

[alaba trap]

Dạ Xin chào tất cả anh chị.
Em có gặp một vẫn để về VBA Excel cần anh chị chỉ giúp.
Vẫn đề em gặp là khi mở UserForm và tìm kiếm dữ liễu thì xuất hiện kết quả tìm kiếm và những dòng trống và em muốn chỉ hiện kết quả bỏ những dòng trống trong listbox.
Dạ dưới đây là file đính kèm
Em xin cảm ơn

 

[huuthang_bd]

Dạ Xin chào tất cả anh chị.
Em có gặp một vẫn để về VBA Excel cần anh chị chỉ giúp.
Vẫn đề em gặp là khi mở UserForm và tìm kiếm dữ liễu thì xuất hiện kết quả tìm kiếm và những dòng trống và em muốn chỉ hiện kết quả bỏ những dòng trống trong listbox.
Dạ dưới đây là file đính kèm
Em xin cảm ơn

Bạn tìm và thay đoạn mã này vào.

Private Sub txt_search_Change()
    Dim lr
    Dim arr(), kg(), i As Long, a As Long, dk As String
    
    dk = UCase(txt_search.Text)
    lr = Sheet1.Cells(Rows.Count, "A").End(xlUp).Row
    arr = Sheet1.Range("A3:J" & lr).Value
    
    Dim aTmp As Variant
    ReDim aTmp(1 To UBound(arr, 1)) As Boolean
    
    For i = 1 To UBound(arr, 1)
        If UCase(arr(i, 1)) Like "*" & dk & "*" _
            Or UCase(arr(i, 2)) Like "*" & dk & "*" _
            Or UCase(arr(i, 3)) Like "*" & dk & "*" Then
            a = a + 1
            aTmp(i) = True
        End If
    Next i
    If a > 0 Then
        ReDim kq(1 To a, 1 To 10)
        a = 0
        For i = 1 To UBound(aTmp, 1)
            If aTmp(i) Then
                a = a + 1
                'kq(a, 0) = arr(i, 0)
                kq(a, 1) = arr(i, 1)
                kq(a, 2) = arr(i, 2)
                kq(a, 3) = arr(i, 3)
                kq(a, 4) = arr(i, 4)
                kq(a, 5) = arr(i, 5)
                kq(a, 6) = arr(i, 6)
                kq(a, 7) = arr(i, 7)
                kq(a, 8) = arr(i, 8)
                kq(a, 9) = arr(i, 9)
                kq(a, 10) = arr(i, 10)
            End If
        Next i
    End If
    lsb1 = ""
    lsb1.Clear
    If a > 0 Then lsb1.List = kq
End Sub

 

[alaba trap]

Bạn tìm và thay đoạn mã này vào.

Private Sub txt_search_Change()
    Dim lr
    Dim arr(), kg(), i As Long, a As Long, dk As String
   
    dk = UCase(txt_search.Text)
    lr = Sheet1.Cells(Rows.Count, "A").End(xlUp).Row
    arr = Sheet1.Range("A3:J" & lr).Value
   
    Dim aTmp As Variant
    ReDim aTmp(1 To UBound(arr, 1)) As Boolean
   
    For i = 1 To UBound(arr, 1)
        If UCase(arr(i, 1)) Like "*" & dk & "*" _
            Or UCase(arr(i, 2)) Like "*" & dk & "*" _
            Or UCase(arr(i, 3)) Like "*" & dk & "*" Then
            a = a + 1
            aTmp(i) = True
        End If
    Next i
    If a > 0 Then
        ReDim kq(1 To a, 1 To 10)
        a = 0
        For i = 1 To UBound(aTmp, 1)
            If aTmp(i) Then
                a = a + 1
                'kq(a, 0) = arr(i, 0)
                kq(a, 1) = arr(i, 1)
                kq(a, 2) = arr(i, 2)
                kq(a, 3) = arr(i, 3)
                kq(a, 4) = arr(i, 4)
                kq(a, 5) = arr(i, 5)
                kq(a, 6) = arr(i, 6)
                kq(a, 7) = arr(i, 7)
                kq(a, 8) = arr(i, 8)
                kq(a, 9) = arr(i, 9)
                kq(a, 10) = arr(i, 10)
            End If
        Next i
    End If
    lsb1 = ""
    lsb1.Clear
    If a > 0 Then lsb1.List = kq
End Sub

Dạ em cảm ơn nhiều ❤❤