Hacer rápido y eficaz el código buscador
Pregunta para Dante. Hola Dante, recibe mis saludos
En un libro del cual me haz ayudado bastante, está este código que es BASTANTE LENTO y mientras más líneas con datos tenga la hoja, más lento es.
Además de eso, busca por cualquier parte Y PUNTO de la cadena, (frase) y quiero que busque en la 1ª palabra y letra de la cadena, Ej.: Llaves para aceite que según voy introduciendo carácter, me vaya mostrando las frases en que la 1ª letra de la 1ª palabra de la frase sea l(el) manojo. Si sigo introduciendo carácter, l, a, v, e. Es, me da la 1ª palabra Llaves de la frase Llaves para aceite o frases en que la 1ª palabra sea Llaves, pero que no me de por ejemplo Manojo de Llaves, Maletín con manojo de llaves, etc.
Sub Filtrar()
Dim Hoj As Worksheet, Copia As Boolean, Texto As String, Tipo As Byte
Dim fil As Worksheet
Dim hojaRow As Range, c_Hoja As String, Orig As Long, Dest As Long
'Si no hay texto a filtrar SALE
If Buscar2.Text = "" Then Exit Sub
'Nombre de hoja y referencia
c_Hoja = cboHojas.Text
Set Hoj = Sheets(c_Hoja)
Set fil = Sheets("Filtro")
'Limpia Hoja Filtro
fil.Visible = True
fil.Select
'Cells.Select
fil.Cells.Clear
'Selection.ClearContents
fil.Range("A2").Select
'Copia Cabecera y Prepara variables
Hoj.Range("A1:G1").Copy fil.Range("A1:G1")
Texto = UCase(Buscar2.Text)
Tipo = FiltrarPor2.ListIndex
Orig = 2
Dest = 1
'Copia los datos filtrados a la hoja Filtro
With Hoj
While .Cells(Orig, 1) <> ""
Copia = False
If Tipo = 1 And InStr(UCase(.Range("A" & Orig)), Texto) > 0 Then Copia = True
If Tipo = 2 And InStr(UCase(.Range("B" & Orig)), Texto) > 0 Then Copia = True
If Tipo = 3 And InStr(UCase(.Range("D" & Orig)), Texto) > 0 Then Copia = True
If Copia Then
Dest = Dest + 1
.Range("A" & Orig & ":G" & Orig).Copy fil.Range("A" & Dest)
End If
Orig = Orig + 1
Wend
End With
'Carga la tabla de datos al ListBox
Set hojaRow = fil.Range(Cells(2, 1), Cells(Dest, 7))
lista.RowSource = ""
lista.RowSource = hojaRow.Address
fil.Visible = False
Sheets("Inicio").Select
End Subque hace parte de este
Private Sub Buscar2_Change() Application.ScreenUpdating = False 'Deactiva la seleccion de articulo Call Sin_Articulo 'Filtrar Datos - Copia los datos Filtrados a la Hoja FILTRO Call Filtrar Inicio.Select Application.ScreenUpdating = True End Sub
El buscador, Buscar2, busca por criterio seleccionado en textBox FiltrarPor2
Agradecido por la atencio en que puedas prestar a este mi caso
2 respuestas
Voy con el.
El código está een el frmEntraSale.
Si verificas el código del frmProd, es rápido, eficaz y su búsqueda es por 1º palabra de la cadena y mediante se van introduciendo caracteres, te va mostrando la o las frases con palabras
Te anexo el código
Sub Filtrar()
'Act.Por.Dante Amor
Dim Hoj As Worksheet, fil As Worksheet
Dim col, u
' </> ---&--- Si no hay texto a filtrar SALE
If Buscar2.Text = "" Then Exit Sub
' </> ---&--- Nombre de hoja y referencia
Set Hoj = Sheets(cboHojas.Text)
Set fil = Sheets("Filtro")
' </> ---&--- Limpia Hoja Filtro
fil.Cells.Clear
'Prepara filtro avanzado
Select Case FiltrarPor2.ListIndex
Case 1: col = "A"
Case 2: col = "B"
Case 3: col = "D"
End Select
fil.Range("I1").Value = Hoj.Cells(1, col)
fil.Range("I2").Value = Buscar2.Text
u = Hoj.Range("A" & Rows.Count).End(xlUp).Row
Hoj.Range("A1:G" & u).AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=fil.Range("I1:I2"), CopyToRange:=fil.Range("A1:G1"), Unique:=False
'carga datos en el listbox
u = fil.Range("A" & Rows.Count).End(xlUp).Row
lista.RowSource = fil.Name & "!" & fil.Range(fil.Cells(2, 1), fil.Cells(u, 7)).Address
End Sub.
sal u dos
.
