Saltar al contenido

Filtrar datos entre dos fechas


Recommended Posts

Buenos días, estoy intentanto hacer un filtro avanzado en vba y no consigo que funcione. Estuve viendo un ejemplo que solucionaba Antoni pero ni así...

Os paso el código para ver si podeis darme un poco de ayuda.

Lo que me gustaría conseguir es un autofiltro  avanzado donde pueda filtra las filas entre dos fechas que yo introduzca con un "inputbox"


 Sub filtrarfecha()
    Dim FechaIni As date,

    Dim FechaFin As date
    
    FechaIni = InputBox("Ponga fecha inicio")
    FechaFin = InputBox("Ponga fecha fin")
   
    ActiveSheet.Range("a5:a13").AutoFilter field:=1, _
        Criteria1:=">=" & FechaIni, _
        Operator:=xlAnd, _
        Criteria2:="<=" & FechaFin
        
        ActiveSheet.AutoFilter.ApplyFilter
End Sub

 

Gracias por adelantado

Enlace a comentario
Compartir con otras webs

Hace 16 horas, Antoni dijo:

Sube tu archivo con datos para poderprobar.

PruebaFiltro.xlsm Antoni es una tabla sencilla que he creado para familiarizarme con lo que quiero hacer,

Saludos  y muchas gracias Antoni

 

JSDJSD Gracias por tu  ejemplo, podrías si no es mucha molestia explicar el código?

Enlace a comentario
Compartir con otras webs

Simplemente te reemplace esta  línea ListBoxLista.Clear  por ListBoxLista.RowSource = "", el resto del código es tuyo, de todos modos si necesitas una explicación del mismo te subo tu código comentariado.

** Cuando se usa RowSource para cargar ListBox no se puede borrar este con Clear, si no que tienes que usar la propiedad RowSource="" para borrarlo.

Private Sub BtnBuscar_Click()

    Dim fin As Long, i As Long, n As Long
    Dim sCadena_seccion As String
    
    Set FILTRAR = ActiveWorkbook.Worksheets("Listado")
       
    
    With FILTRAR
        fin = Application.CountA(.Range("A:A"))
        If TxtBuscador = "" Then
            Me.ListBoxLista.RowSource = ("A2:G") & FILTRAR.Range("A" & Rows.Count).End(xlUp).Row
            Exit Sub
        End If
        
        For i = 2 To fin
            sCadena_seccion = .Cells(i, 1).Value
            If UCase(sCadena_seccion) Like "*" & UCase(TxtBuscador.Value) & "*" Then
                ListBoxLista.RowSource = ""
                
                Me.ListBoxLista.AddItem
                Me.ListBoxLista.List(n, 0) = .Cells(i, 1).Value
                Me.ListBoxLista.List(n, 1) = .Cells(i, 2).Value
                Me.ListBoxLista.List(n, 2) = .Cells(i, 3).Value
                Me.ListBoxLista.List(n, 3) = .Cells(i, 4).Value
                Me.ListBoxLista.List(n, 4) = .Cells(i, 5).Value
                Me.ListBoxLista.List(n, 5) = .Cells(i, 6).Value
                Me.ListBoxLista.List(n, 6) = .Cells(i, 7).Value
                n = n + 1
            End If
        Next
        Me.ListBoxLista.ColumnWidths = "30pt;150pt;150pt;50pt;50pt;60pt;60pt"
    End With
End Sub

 

Enlace a comentario
Compartir con otras webs

Hace 1 hora, JSDJSD dijo:

Perdón esto no tenía que ponerlo aquí.

ok JSDJSD, cuando puedas coméntame tu código porfa que me cuesta seguirlo.

El código que yo adjunté hace que se filtre todo y desaparecen los datos. No acabo de ver donde está el problema...Alguna idea?

Otra consulta, si el  formato de fecha que yo tengo en la tabla es "dd/mm/aaa hh:mm:ss" si meto en el inputbox la fecha formato "dd/mm/aaaa" filtrará correctamente?

 

Gracias por participar en el hilo.

Enlace a comentario
Compartir con otras webs

Este si es el tuyo

Private Sub TextBox2_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)

    If KeyCode = 13 Then  ' Si pulsamos Enter  en textbox2 se ejecuta la macro
    
        date1 = TextBox1: Date2 = TextBox2 ' Asignamos  a las variales su valor
        
        With Sheets("Hoja1").Range("A1").CurrentRegion  ' Seleccionamos todo rango desde A1
        'Filtramos en la columna 1 según condicion por dos criterios en este caso >= y <=
        .AutoFilter 1, Criteria1:=">=" & CDbl(CDate(date1)), Operator:=xlAnd, Criteria2:="<=" & CDbl(CDate(Date2))
        Hoja3.Range("A1").CurrentRegion.Delete 'Borramos el contenido de la hoja3
        .SpecialCells(12).Copy Hoja3.Range("A1") 'Copiamos a partir del A1 las filas visibles del filtrado
        Me.ListBox1.RowSource = Hoja3.Range("A1"). _
        CurrentRegion.Offset(0).Address(, , , 1) ' Cargamos los datos en listbox
        .AutoFilter ' Quitamos filtro
        End With
    
    End If
    
End Sub

 

Enlace a comentario
Compartir con otras webs

Tu macro con algún arreglillo ya funciona:

Sub filtrarfecha(): On Error GoTo ErrorFechas
    Dim FechaIni As Long
    Dim FechaFin As Long
    
    FechaIni = CLng(CDate(InputBox("Ponga fecha inicio")))
    FechaFin = CLng(CDate(InputBox("Ponga fecha fin")))
   
    ActiveSheet.Range("a5:a13").AutoFilter field:=1, _
        Criteria1:=">=" & FechaIni, _
        Operator:=xlAnd, _
        Criteria2:="<=" & FechaFin
        
   Exit Sub
ErrorFechas:
   MsgBox "Filtro cancelado por error en fechas introducidas", vbCritical
End Sub

 

Enlace a comentario
Compartir con otras webs

He probado el código y funciona muy bien Antoni, quiero testearlo más para adaptarlo a más cosillas que quiero hacer.

JSDJSD me ha parecido muy interesante tu código, muchas gracias, me abre la mente para futuros códigos.

Muchas Gracias por la participación a  los dos, JSDJSD y Antoni. 

 

 

 

 

Enlace a comentario
Compartir con otras webs

Archivado

Este tema está ahora archivado y está cerrado a más respuestas.

  • 98 ¿Te parecen útiles los tips de las funciones? (ver tema completo)

    1. 1. ¿Te parecen útiles los tips de las funciones?


      • No
      • Ni me he fijado en ellos

  • Ayúdanos a mejorar la comunidad

    • Donaciones recibidas este mes: 0.00 EUR
      Objetivo: 130.00 EUR
  • Archivos

  • Estadísticas de descargas

    • Archivos
      177
    • Comentarios
      90
    • Revisiones
      27

  • Crear macros Excel

  • Mensajes

    • He descargado tu archivo y funciona correctamente, revisa el video adjunto:
    • Hola perdon no pegue todo mi codigo, no lo copie bien es este al principio: Sub MacroG() Application.ScreenUpdating = False       Mensaje = "No se pueden guardar los datos aún hay celdas vacías:" 'Recorremos las celdas For i = 1 To 6     If Sheets("INGRESO").Range("DATO" & i).Value = "" Then         Valor = Sheets("INGRESO").Range("DATO" & i).AddressLocal         Valor1 = Valor1 & VBA.vbNewLine & Valor     End If   Next i   If Not Valor1 = "" Then     MsgBox Mensaje & VBA.vbNewLine & Valor1, vbExclamation, "Ingreso de Productos" Else     End If   Donde cada celda le cambie el cuadro de nombre C4= DATO1 C5= DATO2 C6= DATO3 C7= DATO4 F4= DATO5 F5= DATO6 asi estoy seleccionando las celdas Comparto mi macro que esta en la nube https://files.fm/u/uzb68tetng  
    • No has especificado cuales son las celdas a validar si están vacías, te he puesto un ejemplo para el rango A1:A6, corrige a voluntad: Sub Borrar() '------- Corregir las celdas según necesidad If Range("A1") = "" Or _ Range("A2") = "" Or _ Range("A3") = "" Or _ Range("A4") = "" Or _ Range("A5") = "" Or _ Range("A6") = "" Then MsgBox "Hay celdas vacías", vbInformation Exit Sub End If '------- Range("C5").ClearContents Range("C7").ClearContents Range("C8").ClearContents Range("C23").ClearContents Range("C24").ClearContents Range("C39").ClearContents Range("C40").ClearContents Range("C55").ClearContents Range("C56").ClearContents Range("C71").ClearContents Range("C72").ClearContents Range("C87").ClearContents Range("C88").ClearContents Range("C103").ClearContents Range("C104").ClearContents Range("C119").ClearContents Range("C120").ClearContents Range("C135").ClearContents Range("C136").ClearContents Range("C151").ClearContents Range("C152").ClearContents End Sub  
    • Hola me podrian ayudar a corregir esta macro, ya que que he puesto la condicion que no se ejecute por si hay valores vacios en 6 celdas y siempre se ejecuta, comparto codigo:     Selection.ClearContents     Range("C5").Select     Selection.ClearContents     Selection.ClearContents     Range("C7").Select     Selection.ClearContents     Selection.ClearContents     Range("C8").Select     Selection.ClearContents     Range("C23").Select     Selection.ClearContents     Range("C24").Select     Selection.ClearContents     Range("C39").Select     Selection.ClearContents     Selection.ClearContents     Selection.ClearContents     Range("C40").Select     Selection.ClearContents     Range("C55").Select     Selection.ClearContents     Range("C56").Select     Selection.ClearContents     Range("C71").Select     Selection.ClearContents     Selection.ClearContents     Range("C72").Select     Selection.ClearContents     Range("C87").Select     Selection.ClearContents     Range("C88").Select     Selection.ClearContents     Range("C103").Select     Selection.ClearContents     Range("C104").Select     Selection.ClearContents     Range("C119").Select     Selection.ClearContents     Range("C120").Select     Selection.ClearContents     Range("C135").Select     Selection.ClearContents     Range("C136").Select     Selection.ClearContents     Range("C151").Select     Selection.ClearContents     Range("C152").Select     Selection.ClearContents     Range("A1").Select     Selection.End(xlUp).Select     Selection.End(xlUp).Select     Selection.End(xlUp).Select     Selection.End(xlToLeft).Select     Selection.End(xlToLeft).Select     Selection.End(xlToLeft).Select     Selection.End(xlToLeft).Select     Selection.End(xlUp).Select     Selection.End(xlUp).Select     Selection.End(xlUp).Select     Selection.End(xlToLeft).Select     Range("C4").Select         End Sub
  • Visualizado recientemente

    • No hay usuarios registrado para ver esta página.
×
×
  • Crear nuevo...

Información importante

Echa un vistazo a nuestra política de cookies para ayudarte a tener una mejor experiencia de navegación. Puedes ajustar aquí la configuración. Pulsa el botón Aceptar, si estás de acuerdo.