Como Hacer un filtrado con RowSource en vba

Como puedo cambiar este código pero utilizando RowSource para hacer filtrado con 5 textBox

Private Sub TextB1_Change()
Call Filtrar
End Sub
Private Sub TextB2_Change()
Call Filtrar
End Sub
Private Sub TextB3_Change()
Call Filtrar
End Sub
Private Sub TextB4_Change()
Call Filtrar
End Sub
Private Sub TextB5_Change()
Call Filtrar
End Sub
Sub Filtrar()

Set h = Sheets("Formulario")
uf = h.Range("A" & Rows.Count).End(xlUp).Row
If h.AutoFilterMode Then h.AutoFilterMode = False
ListBox1.Clear
'Carga los datos de la cabecera en listbox
ListBox1.AddItem
For ii = 0 To 9
ListBox1.List(0, ii) = h.Cells(1, ii + 1)
Next ii
'
For i = 2 To uf
str1 = h.Cells(i, 8).Value
str2 = h.Cells(i, 2).Value
str3 = h.Cells(i, 3).Value
str4 = h.Cells(i, 10).Value
str5 = h.Cells(i, 1).Value
If TextB1.Value = "" Then text1 = str1 Else text1 = TextB1.Value
If TextB2.Value = "" Then text2 = str2 Else text2 = TextB2.Value
If TextB3.Value = "" Then text3 = str3 Else text3 = TextB3.Value
If TextB4.Value = "" Then text4 = str4 Else text4 = TextB4.Value
If TextB5.Value = "" Then text5 = str5 Else text5 = TextB5.Value
If UCase(str1) Like UCase(text1) & "*" And _
UCase(str2) Like UCase(text2) & "*" And _
UCase(str3) Like UCase(text3) & "*" And _
UCase(str4) Like UCase(text4) & "*" And _
UCase(str5) Like UCase(text5) & "*" Then
Me.ListBox1.AddItem h.Cells(i, 1)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = h.Cells(i, 2)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = h.Cells(i, 3)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 3) = h.Cells(i, 4)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 4) = h.Cells(i, 5)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 5) = h.Cells(i, 6)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 6) = h.Cells(i, 7)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 7) = h.Cells(i, 8)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 8) = h.Cells(i, 9)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 9) = h.Cells(i, 10)

End If
Next i
End Sub

1 Respuesta

Respuesta
2

Te anexo el código Tienes que crear una hoja y le pones por nombre "Temp"

Lo que hace la macro es filtrar las columnas con los datos que pongas en los text, copia la información filtrada a la hoja "temp" y después carga con rowsource el contenido de la hoja "temp"

Private Sub TextB1_Change()
    Call Filtrar
End Sub
Private Sub TextB2_Change()
    Call Filtrar
End Sub
Private Sub TextB3_Change()
    Call Filtrar
End Sub
Private Sub TextB4_Change()
    Call Filtrar
End Sub
Private Sub TextB5_Change()
    Call Filtrar
End Sub
'
Sub Filtrar()
'Por. Dante Amor
    Application.ScreenUpdating = False
    Set h1 = Sheets("Formulario")
    Set h2 = Sheets("Temp")
    h2.Cells.ClearContents
    '
    If h1.AutoFilterMode Then h1.AutoFilterMode = False
    u1 = h1.Range("A" & Rows.Count).End(xlUp).Row
    uc = h1.Cells(1, Columns.Count).End(xlToLeft).Column
    If TextB1.Value = "" Then str1 = "*" Else str1 = TextB1.Value
    If TextB2.Value = "" Then str2 = "*" Else str2 = TextB2.Value
    If TextB3.Value = "" Then str3 = "*" Else str3 = TextB3.Value
    If TextB4.Value = "" Then str4 = "*" Else str4 = TextB4.Value
    If TextB5.Value = "" Then str5 = "*" Else str5 = TextB5.Value
    h1.Range(h1.Cells(1, 1), h1.Cells(u1, uc)).AutoFilter Field:=8, Criteria1:=str1
    h1.Range(h1.Cells(1, 1), h1.Cells(u1, uc)).AutoFilter Field:=2, Criteria1:=str2
    h1.Range(h1.Cells(1, 1), h1.Cells(u1, uc)).AutoFilter Field:=3, Criteria1:=str3
    h1.Range(h1.Cells(1, 1), h1.Cells(u1, uc)).AutoFilter Field:=10, Criteria1:=str4
    h1.Range(h1.Cells(1, 1), h1.Cells(u1, uc)).AutoFilter Field:=1, Criteria1:=str5
    '
    ListBox1.RowSource = ""
    u1 = h1.Range("A" & Rows.Count).End(xlUp).Row
    If u1 > 1 Then
        h1.Rows("1:" & u1).Copy
        H2. Range("A1"). PasteSpecial xlValues
 h2. Range("A1").PasteSpecial xlPasteFormats
        u2 = h2.Range("H" & Rows. Count).End(xlUp).Row
        rango = h2. Range(h2.Cells(2, "A"), h2. Cells(u2, uc)). Address
 h2. Cells. EntireColumn. AutoFit
        For i = 1 To uc
            ancho = ancho & Int(h2.Range("A" & i).Width) + 3 & "; "
        Next
        ListBox1.ColumnCount = uc
        ListBox1.ColumnHeads = True
        ListBox1.ColumnWidths = ancho
        ListBox1.RowSource = h2.Name & "!" & rango
    End If
    Application.ScreenUpdating = True
    Application.CutCopyMode = False
End Sub

El código copia la primera fila de la hoja "Formulario" a la hoja "temp", después el listbox tiene la propiedad ColumnsHeads = True, con eso se carga en automático el encabezado en cada columna.

También en automático se calcula el número de columnas a cargar en el listbox, si hay 10 o más columna con encabezado en la fila 1, el listbox recalcula las columnas a cargar.

'.[Sal u dos. Dante Amor. No olvides valorar la respuesta. 
'.[Avísame cualquier duda

amigo no hizo nada..

al hacer un filtrado  en un textBox me borra todo en el listBox y cuando ya borro lo que quería filtrar ya no se visualiza mi base en el listBox.

Tal vez te sirva esta inf.(asi es como se llena mi base en mi listBox con rowsource) lo que necesito es un metodo para poder fltrar en 5 textBox 

Private Sub UserForm_Initialize()

On Error Resume Next
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set b = Sheets("Formulario")
uf = b.Range("A" & Rows.Count).End(xlUp).Row
uc = b.Cells(1, Columns.Count).End(xlToLeft).Address
wc = Mid(uc, InStr(uc, "$") + 1, InStr(2, uc, "$") - 2)
With Me.ListBox1
.ColumnCount = 12
.ColumnWidths = "60 pt;50 pt;40 pt;60 pt;60 pt;60 pt;60 pt; 60 pt; 60 pt; 60 pt; 60pt"
.RowSource = "Formulario!A1:" & wc & uf
End With
'Carga los datos de la cabecera en listbox
For ii = 0 To 12
UserForm1.ListBox1.List(0, ii) = Sheets("Formulario").Cells(1, ii + 1)
Next ii

Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Revisa bien mi código, lo probé en un formulario y funciona con cualquiera de los 5 textbox.

ya revise el código  y sigue sin hacer nada.  podrías mandarme tu prueba. para ver como lo estas haciendo.. [email protected]

Listo, te envié el ejemplo

amigo te envié el mio por correo. por que no me sale, espero y lo puedas checar

¿Probaste mi ejemplo?

En el correo te puse indicaciones de los datos que debes poner.

¿Tuviste algún problema con mi ejemplo? ¿Qué problema?

pues cheque el código. y lo compare con el mio. Pero no sale  

Pero, ¿Probaste mi ejemplo?

seeee. y si sale amigo. pero no se que estoy haciendo mal

Entonces mi macro funciona!

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas