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

Respuesta
1

. 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:

  1. Que lo ingresado sea una fecha válida
  2. 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

.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas