Sub Loc()
Dim Dl(), I As Long, Tam, K As Long, J As Long, DK, Lst
Dl = Sheet2.Range("A2", Sheet2.Range("A65000").End(3)).Resize(, 2).Value
ReDim Tam(1 To UBound(Dl), 1 To 5)
If ActiveSheet.TextBox1.Value = Empty Then
DK = "*"
Else
DK = "*" & UCase(TV(ActiveSheet.TextBox1.Value)) & "*"
End If
For I = 1 To UBound(Dl)
If Dl(I, 1) <> Empty Then
If UCase(TV(Dl(I, 2))) Like DK Then
K = K + 1
For J = 1 To UBound(Dl, 2)
Tam(K, J) = Dl(I, J)
Next J
End If
End If
Next I
On Error Resume Next
ReDim Lst(1 To K, 1 To 2)
K = 0
For I = 1 To UBound(Tam)
If Tam(I, 1) <> Empty Then
K = K + 1
For J = 1 To UBound(Tam, 2)
Lst(K, J) = Tam(I, J)
Next J
End If
Next I
With ActiveSheet.ListBox1
.Clear
.List() = Lst
End With
End Sub
