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
. 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 Sub
La 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 Sub
Desde 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