Filtrar por textos o por números u otros valores
Dante, buenas noches.
Ya me habías ayudado con mi proyecto, la primer etapa de mi trabajo consistía en un formulario donde un listbox se llenaba con un filtro -combobox- donde utilizaba un textbox para buscar el dato específico. Mas luego quise filtrar por fecha y me sugeriste usar dos textbox, cuyo código, que me adjuntaras, anduvo muy bien para ello.
Ahora bien, quisiera que el primer textbox me vuelva a permitir buscar por un dato específico de cualquier columna, por ejemplo un número de la primer columna o un texto de la segunda o cualquier otra columna sin perder la posibilidad de seguir filtrando por fechas cuando sea necesario.
No sé si debería agregar un tercer textbox para haga esa parte, es decir para que busque un texto o un número en cualquier columna y dejar los otros dos para filtrar por fechas o ¿habrá alguna modificación en la macro que pudieras sugerirme para ello?
1 respuesta
Te anexo el código para filtrar
Private Sub CommandButton5_Click()
'Por.Dante Amor
'filtrar
Set h1 = Sheets("Hoja1")
Set h2 = Sheets("Temporal")
'
h2.Cells.Clear
ListBox1.RowSource = ""
'
If cmbEncabezado = "" Or cmbEncabezado.ListIndex = -1 Then
MsgBox "Selecciona un filtro"
cmbEncabezado.SetFocus
Exit Sub
End If
If Me.txtFiltro1.Value = "" Then
MsgBox "Captura un dato"
txtFiltro1.SetFocus
Exit Sub
End If
h1.Rows(1).Copy h2.Rows(1)
uc = h2.Cells(1, Columns.Count).End(xlToLeft).Column
'
'valida si se va a filtrar por fecha
fec = ""
col = cmbEncabezado.ListIndex + 1
If col = 2 Then
If Me.TextBox2.Value = "" Then
MsgBox "Captura fecha hasta"
TextBox2.SetFocus
Exit Sub
End If
If Not IsDate(Me.txtFiltro1.Value) Then
MsgBox "Captura fecha Desde válida"
txtFiltro1.SetFocus
Exit Sub
End If
If Not IsDate(Me.TextBox2.Value) Then
MsgBox "Captura fecha Hasta válida"
TextBox2.SetFocus
Exit Sub
End If
fec1 = CDate(txtFiltro1.Value)
fec2 = CDate(TextBox2.Value)
If fec2 < fec1 Then
MsgBox "La fecha Hasta no puede ser menor a la fecha Desde"
TextBox2.SetFocus
Exit Sub
End If
End If
'
Application.ScreenUpdating = False
j = 2
For i = 2 To h1.Range("A" & Rows.Count).End(xlUp).Row
If fec2 = "" Then
'filtra texto
If "" & h1.Cells(i, col).Value Like "*" & txtFiltro1.Value & "*" Then
h1.Rows(i).Copy h2.Rows(j)
j = j + 1
End If
Else
'filtra por fecha
If h1.Cells(i, col) >= fec1 And h1.Cells(i, col) <= fec2 Then
h1.Rows(i).Copy h2.Rows(j)
j = j + 1
End If
End If
Next
'
u2 = h2.Range("A" & Rows.Count).End(xlUp).Row
If u2 = 1 Then
MsgBox "No existen registros con ese filtro", vbExclamation, "FILTRO"
Else
rango = Range(Cells(2, "A"), Cells(u2, uc)).Address
h2.Cells.EntireColumn.AutoFit
ancho = ""
For i = 1 To uc
ancho = ancho & Int(h2.Cells(1, i).Width) + 3 & ";"
Next
'
ListBox1.RowSource = h2.Name & "!" & rango
ListBox1.ColumnCount = uc
ListBox1.ColumnHeads = True
ListBox1.ColumnWidths = ancho
End If
Application.ScreenUpdating = True
End Sub.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
.
Avísame cualquier duda
.
