Informe con filtros avanzados excel
Tengo un archivo de excel
En una hoja de calculo tengo mi informacion base de clientes,
Lo que quiero es que en otra hoja de calculo se pueda hacer un filtro con cliente y rango de fechas, el rango de fechas es el que se llama (Fecha_Contabilización) Adjunto archivo
1 respuesta
. 23.11.16 #VBA Filtro Avanzado
Buenas, Krauxs
La siguiente rutina hace lo que solicitas, utilizando los filtros avanzados de MS Excel.
Para que funcione, necesitas colocar los títulos de las columnas de la base original que necesitas que aparezcan en la segunda hoja. Si fueran todos, copia la linea de la base original y pegala en la hoja mencionada. Es decir, puedes extraer todos los campos de la base original o solo aquellos que te interese.
Luego, y esto es fundamental, elige un rango libre de dos lineas y una columna en la hoja de destino donde colocar el criterio de extracción, por ejemplo D2:F3, en la hoja donde se extraigan los datos
En la primera celda de esas dos filas coloca el mismo título de la columna donde esté el dato clave y abajo el criterio. Para el caso de un determinado período repite el titulo de fecha de Contabilización 2 veces. En la primera indicas el inicio y en la segunda, el final.
Algo así como esto:

Luego, accede al Editor de VBA (Atajo: Alt + F11), inserta un módulo - si no tuvieras uno ya- y pega el siguiente código:
Sub XtraeClie() '---- Variables modificables: '=== Krauxs, modifica estos datos de acuerdo a tu proyecto: HojaOrig = "BASE DE DATOS" HojaDest = "DETALLE CLIENTE" CritAreaH = "D2:F3" 'rango donde se coloca el criterio de extracción SourceAreaH = "A12:CY14000" ' rango base de datos de origen OutpAreaH = "A13:BH13" ' fila de títulos en hoja de destino '---- fin Variables ' '---- inicio de rutina: ' Sheets(HojaDest).Select Sheets(HojaOrig).Range(SourceAreaH).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range(CritAreaH), _ CopyToRange:=Range(OutpAreaH), Unique:=False End Sub
Veras al inicio del código unas variables que deberás adaptar a los rangos propios de tu libro.
Como verás, esta forma flexibiliza lo que quieras extraer, simplemente cambiando el criterio en el rango que indicaste.
Parece que no se adjunto el archivo que mencionaste, pero entiendo que adaptando los rangos dentro del código te debería funcionar.
Coméntame si es lo que buscabas -y, en tal caso, agradeceré que califiques mi contribución- o escribeme de nuevo aquí, si necesitas más apoyo con esto.
Un abrazo
Fernando
(Buenos Aires, Argentina)
.
Hola Fejoal
Gracias por tu ayuda
Pero tengo una pregunta, hay alguna forma de que cuando valla a generar el informe me salga una ventana con los filtro a realizar como nit del cliente y fecha inicial y fecha final, esto se podría hacer
.
Hola, Krauxs
Sí, es posible.
Requiere un poco más de programación pero creo que esto te será útil:
Sub XtrCliexFecha()
'---- Variables modificables:
'=== Krauxs, modifica estos datos de acuerdo a tu proyecto:
HojaOrig = "BASE DE DATOS"
HojaDest = "DETALLE CLIENTE"
CritAreaH = "D2:F3" 'rango donde se coloca el criterio de extracción
SourceAreaH = "A12:CY14000" ' rango base de datos de origen
OutpAreaH = "A13:BH13" ' fila de títulos en hoja de destino
'---- fin Variables
'
'---- inicio de rutina:
'
Sheets(HojaDest).Select
Range(CritAreaH).Cells(2, 1).Select
clie = InputBox(" Ingresar NIT del Cliente" & Chr(10) & "(Vacío o Cancelar para salir sin filtrar)", "CLIENTE A FILTRAR")
If clie = "" Then
Exit Sub
Else
Range(CritAreaH).Cells(2, 1).Value = clie
End If
IngrIni:
Range(CritAreaH).Cells(2, 2).Select
Fini = InputBox(" Ahora ingresar Fecha INICIO (incluida)" & Chr(10) & "(Vacío o Cancelar para salir sin filtrar)", "FECHA INICIO DEL PERIODO")
If Fini = "" Then
Exit Sub
Else
If IsDate(Fini) Then
Range(CritAreaH).Cells(2, 2).Value = ">=" & Fini
Else
ElMensaje = "Lo ingresado: " & Fini & " no es una fecha válida." & Chr(10) & "Reingresela, por favor"
ElTitulo = "FECHA INVALIDA"
TipoMens = vbCritical
MsgBox ElMensaje, TipoMens, ElTitulo
GoTo IngrIni
End If
End If
IngrFin:
Range(CritAreaH).Cells(2, 3).Select
Ffin = InputBox(" Finalmente ingresar Fecha de FIN (incluida)" & Chr(10) & "(Vacío o Cancelar para salir sin filtrar)", "FECHA FINAL DEL PERIODO")
If Ffin = "" Then
Exit Sub
Else
If IsDate(Ffin) Then
If CDate(Ffin) >= CDate(Fini) Then
Range(CritAreaH).Cells(2, 3).Value = "<=" & Ffin
Else
ElMensaje = "La fecha de final: " & Ffin & " es anterior a la de inicio: " & Fini & Chr(10) & "Reingresela o salga en la próxima pantalla, por favor"
ElTitulo = "Fecha Final es anterior a la Inicial"
TipoMens = vbCritical
MsgBox ElMensaje, TipoMens, ElTitulo
GoTo IngrFin
End If
Else
ElMensaje = "Lo ingresado: " & Ffin & " no es una fecha válida." & Chr(10) & "Reingresela, por favor"
ElTitulo = "FECHA INVALIDA"
TipoMens = vbCritical
MsgBox ElMensaje, TipoMens, ElTitulo
GoTo IngrFin
End If
End If
Sheets(HojaOrig).Range(SourceAreaH).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range(CritAreaH), _
CopyToRange:=Range(OutpAreaH), Unique:=False
End SubLa rutina irá pidiendo cada uno de esos datos y lo colocará secuencialmente en la segunda la segunda linea del área que le indicaste como de criterios.
Para las fechas considerará que ambas están incluidas en el período (pero esto es fácil de modifcar si quisiera que no lo estuvieran).
Adicionalmente, para evitar problemas en el filtrado, le agregué un par de controles:
- Que lo ingresado sea una fecha válida
- que la fecha de fin no sea anterior a la que se ingresó en la pantalla anterior.
En ambos casos dará la oportunidad de reingresar el dato.
Espero que esto cubra -con exceso- lo que solicitaste.
Un abrazo
Fer
BUENA TARDE
Esta muy buena, pero no se que hago mal por que le doy los datos y no me filtra el rango de fechas que le especifico siempre me trae la misma información,,,

.
Pues parece que no modificaste correctamente los rangos dentro de las variables que te dejé.
Fíjate que los criterios no están colocados en la fila inmediata inferior a los títulos.
Prueba esta rutina donde le coloqué los rangos correctos, pero revisa si la columna final de salida es la que coloqué (OutpAreaH = "D3:R3"), porque no se ve todo en tu imagen:
Sub XtrCliexFecha()
'---- Variables modificables:
'=== Krauxs, modifica estos datos de acuerdo a tu proyecto:
HojaOrig = "BASE DE DATOS"
HojaDest = "DETALLE CLIENTE"
CritAreaH = "A3:C4" 'rango donde se coloca el criterio de extracción
SourceAreaH = "A12:CY14000" ' rango base de datos de origen
OutpAreaH = "D3:R3" ' fila de títulos en hoja de destino
'---- fin Variables
'
'---- inicio de rutina:
'
Sheets(HojaDest).Select
Range(CritAreaH).Cells(2, 1).Select
clie = InputBox(" Ingresar NIT del Cliente" & Chr(10) & "(Vacío o Cancelar para salir sin filtrar)", "CLIENTE A FILTRAR")
If clie = "" Then
Exit Sub
Else
Range(CritAreaH).Cells(2, 1).Value = clie
End If
IngrIni:
Range(CritAreaH).Cells(2, 2).Select
Fini = InputBox(" Ahora ingresar Fecha INICIO (incluida)" & Chr(10) & "(Vacío o Cancelar para salir sin filtrar)", "FECHA INICIO DEL PERIODO")
If Fini = "" Then
Exit Sub
Else
If IsDate(Fini) Then
Range(CritAreaH).Cells(2, 2).Value = ">=" & Fini
Else
ElMensaje = "Lo ingresado: " & Fini & " no es una fecha válida." & Chr(10) & "Reingresela, por favor"
ElTitulo = "FECHA INVALIDA"
TipoMens = vbCritical
MsgBox ElMensaje, TipoMens, ElTitulo
GoTo IngrIni
End If
End If
IngrFin:
Range(CritAreaH).Cells(2, 3).Select
Ffin = InputBox(" Finalmente ingresar Fecha de FIN (incluida)" & Chr(10) & "(Vacío o Cancelar para salir sin filtrar)", "FECHA FINAL DEL PERIODO")
If Ffin = "" Then
Exit Sub
Else
If IsDate(Ffin) Then
If CDate(Ffin) >= CDate(Fini) Then
Range(CritAreaH).Cells(2, 3).Value = "<=" & Ffin
Else
ElMensaje = "La fecha de final: " & Ffin & " es anterior a la de inicio: " & Fini & Chr(10) & "Reingresela o salga en la próxima pantalla, por favor"
ElTitulo = "Fecha Final es anterior a la Inicial"
TipoMens = vbCritical
MsgBox ElMensaje, TipoMens, ElTitulo
GoTo IngrFin
End If
Else
ElMensaje = "Lo ingresado: " & Ffin & " no es una fecha válida." & Chr(10) & "Reingresela, por favor"
ElTitulo = "FECHA INVALIDA"
TipoMens = vbCritical
MsgBox ElMensaje, TipoMens, ElTitulo
GoTo IngrFin
End If
End If
Sheets(HojaOrig).Range(SourceAreaH).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range(CritAreaH), _
CopyToRange:=Range(OutpAreaH), Unique:=False
End SubDesde luego, también es importante que el rango de base esté correctamente indicado en la macro.
Por lo demás, la rutina funciona OK.
Saludos
Fer
.
- Compartir respuesta