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