Filtro de búsqueda vba excel textbox
Tengo un userform con un textbox1 que funciona como filtro para un listbox1. Cuando se introduce como mínimo 3 caracteres, se aplica el filtro de búsqueda. El evento Change se ejecuta cuando se deja de presionar una tecla.
Funciona relativamente bien, pero se congela cuando se escribe rápidamente "a a a a a a a a a" (a modo de ejemplo).
Necesito otro enfoque, ya que no se me ocurre como solucionar este problema.
Dim allowChange As Boolean
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
allowChange = False
End Sub
Private Sub TextBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If Len(TextBox1.text) > 2 Then
allowChange = True
CargarProductos TextBox1.text
ElseIf TextBox1.text = "" Then
allowChange = True
CargarProductos TextBox1.text
Else
allowChange = False
End If
End Sub
Private Sub TextBox1_Change()
If Not allowChange Then Exit Sub
End Sub
Private Sub UserForm_Initialize()
CargarProductos ""
TextBox1.SetFocus
End Sub
Sub CargarProductos(filtro As String)
Dim ws As Worksheet
Dim lastRow As Long
Dim i As Long
Dim producto As String
Dim columnaItem As Long
Dim productoNormalizado As String
Dim palabrasFiltro() As String
Dim palabra As Variant
Dim coincidencia As Boolean
Dim tbl As ListObject
Set ws = ThisWorkbook.Sheets("Productos")
Set tbl = ws.ListObjects("Products")
columnaItem = tbl.ListColumns("ÍTEM").Index
ListBox1.Clear
lastRow = tbl.ListRows.Count
filtro = NormalizarTexto(filtro)
If Len(filtro) > 0 Then
palabrasFiltro = Split(filtro, " ")
For i = 1 To lastRow
producto = tbl.ListRows(i).Range.Cells(1, columnaItem).value
If Len(producto) > 0 Then
productoNormalizado = NormalizarTexto(producto)
If Len(filtro) = 0 Then
ListBox1.AddItem producto
Else
coincidencia = True
For Each palabra In palabrasFiltro
If InStr(1, productoNormalizado, palabra, vbTextCompare) = 0 Then
coincidencia = False
Exit For
End If
Next palabra
If coincidencia Then
ListBox1.AddItem producto
End If
End If
End If
Next i
End Sub
Function NormalizarTexto(ByVal texto As String) As String
texto = Replace(texto, "á", "a")
texto = Replace(texto, "à", "a")
texto = Replace(texto, "â", "a")
texto = Replace(texto, "ä", "a")
NormalizarTexto = texto
End Function
1 Respuesta
Respuesta de Elsa Matilde
2