¿Se puede utilizar el mètodo "Find" de visual basic para estraer valores entre dos fechas de consulta: Finicio y Ffin?

Haber si alguien me ayuda a salir de dudas con respecto a que si con el método Find de visual basic se pueden evualuar dos fechas Fecha_Inicio y Fecha_Fin para que encuentre los datos comprendidos entre las dos variables y estas se trasladen a otra hoja de excel. Las vartiables estarìan en otra hoja ubicadas en las celas por ejemplo b1 y c1 o si existe otra forma para conseguir esto, pero que no sea con filtros.

1 Respuesta

Respuesta
1

Se puede hacer un ciclo que revise fecha por fecha y validar si está entre el rango de fechas, si es así, entonces toma los datos.

Para concluir la macro, tienes que decirme lo siguiente:

- Nombre de la hoja donde vas a poner las fechas de inicio y fin

- Nombre de la hoja origen de datos

- Columna de la hoja origen donde están las fechas

- Qué datos se van a copiar (letras de las columnas)

- Nombre de la hoja destino

- En dónde se va a pegar los datos

E spero tus comentarios en ese orden

Hola amigo Dante.

Gracias por tu pronta respuesta.

Las hojas serian las siguientes:

1-hoja 1 "Búsqueda" las celdas B2 y B3 es donde se colocarían las fechas 

2-hoja 2 "Datos" es donde se encuentran los datos. La columna "A" esta las fechas, en la "B" esta el tipo de transacción inventario en "C" tipo de transacción venta, en "D" el numero de doc., en "E" el nombre del proveedor, en "F" las unidades, en "G" el costo unitario y en "H" el total, pero este ya posee formula. Todos los datos están se ingresan a partir de la fila 10.

3-Hoja 3 "Resumen" es una copia exacta de la hoja "Datos" solo que acá se pegarían los datos a partir de la columna A a la G según  los datos econtradas entre la Fecha_Inicio y la Fecha_Fin.

Para concluir no se si se puede extraer el valor inmediato anterior a la Fecha_Inicio y pegar el valor de la columna F y G de la hoja Datos en las celdas fijas de la hoja resumen F9 y G9 

Te anexo la macro, incluso lleva la parte de los valores anteriores.

Sub Resumen_Por_Fechas()
'Por.Dante Amor
    Application.ScreenUpdating = False
    Set h1 = Sheets("Datos")
    Set h2 = Sheets("Busqueda")
    Set h3 = Sheets("Resumen")
    '
    h3.Range("A10:G" & Rows.Count).ClearContents
    fec1 = h2.[B2]
    fec2 = h2.[B3]
    If fec1 = "" Then
        MsgBox "Falta fecha inicial"
        Exit Sub
    End If
    If fec2 = "" Then
        MsgBox "Falta fecha final"
        Exit Sub
    End If
    If fec2 < fec1 Then
        MsgBox "La fecha final es menor a la fecha incial"
        Exit Sub
    End If
    '
    j = 10
    n = 0
    For i = 10 To h1.Range("A" & Rows.Count).End(xlUp).Row
        If h1.Cells(i, "A") >= fec1 And h1.Cells(i, "A") <= fec2 Then
            h1.Range("A" & i & ":G" & i).Copy
            h3.Range("A" & j).PasteSpecial xlValues
            j = j + 1
            n = n + 1
        End If
    Next
    '
    'Buscar valor inmediato anterior
    fec_ant = fec1 - 1
    h3.[F9] = ""
    h3.[G9] = ""
    For i = 1 To 7
        Set b = h1.Columns("A").Find(fec_ant, lookat:=xlWhole)
        If Not b Is Nothing Then
            h3.[F9] = h1.Cells(b.Row, "F")
            h3.[G9] = h1.Cells(b.Row, "G")
            Exit For
        Else
            fec_ant = fec_ant - 1
        End If
    Next
    h3.Select
    Application.ScreenUpdating = True
    MsgBox "Registros copiados : " & n, vbInformation, "RESUMEN CREADO"
End Sub

.

'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias

.

Avísame cualquier duda

¡Gracias! Amigo Dante

Como siempre funciona perfecto!

Te quiero pedir un consejo. Yo hasta hace poco he empezado con esto de la programación en Visal Basic y me cuesta bastante poder escribir códigos, si los puedo leer, pero a la hora de elaborar algún procedimiento me cuesta bastante poder hacerlo es como cuando uno empieza la escuela, muchos niños aprenden a leer pero no escribir. ¿Qué me recomiendas aparte de leer más acerca de VBA habrá una técnica?

Trata de replicar mis macros en una hoja de excel para que veas el funcionamiento.

También trata de resolver las preguntas de los usuarios, siempre he dicho que para aprender tienes que tener una necesidad, en este caso la necesidad es de un usuario, pero de esa forma puedes practicar. Si solamente lees un manual y no lo aplicas no vas a entender el funcionamiento.

Si tienes alguna necesidad busca el código y trata de aplicarlo en tu caso.

¡Gracias! 

Gracias te agradezco y tomaré muy en cuenta tu consejo

Buenas tardes Dante.

Por acá de nuevo consultándote algunas cosas y en este caso es referente a esta macro que muy amablemente me procporcinaaste. 

Sub Resumen_Por_Fechas()
'Por.Dante Amor
    Application.ScreenUpdating = False
    Set h1 = Sheets("Datos")
    Set h2 = Sheets("Busqueda")
    Set h3 = Sheets("Resumen")
    '
    h3.Range("A10:G" & Rows.Count).ClearContents
    fec1 = h2.[B2]
    fec2 = h2.[B3]
    If fec1 = "" Then
        MsgBox "Falta fecha inicial"
        Exit Sub
    End If
    If fec2 = "" Then
        MsgBox "Falta fecha final"
        Exit Sub
    End If
    If fec2 < fec1 Then
        MsgBox "La fecha final es menor a la fecha incial"
        Exit Sub
    End If
    '
    j = 10
    n = 0
    For i = 10 To h1.Range("A" & Rows.Count).End(xlUp).Row
        If h1.Cells(i, "A") >= fec1 And h1.Cells(i, "A") <= fec2 Then
            h1.Range("A" & i & ":G" & i).Copy
            h3.Range("A" & j).PasteSpecial xlValues
            j = j + 1
            n = n + 1
        End If
    Next
    '
    'Buscar valor inmediato anterior
    fec_ant = fec1 - 1
    h3.[F9] = ""
    h3.[G9] = ""
    For i = 1 To 7
        Set b = h1.Columns("A").Find(fec_ant, lookat:=xlWhole)
        If Not b Is Nothing Then
            h3.[F9] = h1.Cells(b.Row, "F")
            h3.[G9] = h1.Cells(b.Row, "G")
            Exit For
        Else
            fec_ant = fec_ant - 1
        End If
    Next
    h3.Select
    Application.ScreenUpdating = True
    MsgBox "Registros copiados : " & n, vbInformation, "RESUMEN CREADO"
End Sub

En esa ocación se me olvidó mencionar un detalle creo, y tiene que ver con la variable "fec_ant" en la que su función es determinar la fecha inmediato anterior a las fec1 (Fecha inicial), el punto es que en un determinado caso pueden haber varias fechas iguales es decir por ejemplo 5 líneas de datos con las misma fecha y es ahí donde está el detalle que la macro no está tomando el valor necesario, no digo que la macro no fucniona, porque lo hace perfecto, sino que se me olvidó ese detalle programarlo. Acá te dejo un ejemplo cencillo para mayor comprensión:

Como podrás observar en la columna "C" se encuentran varias fechas y todas se repiten con distintos registros. Al ejecutar la macro pasa todos los datos comprendidos en el rango selecionado(03/052017 al 06/05/2017) a la hoja Resumen, haciéndolo a la perfección.

 Ahora bien, el detalle está que a la hora de buscar y copiar los valores que corresponden a la fecha anterior de la fecha inicial, la macro recorre la columna "C" y se tre el primer valor de arriba hacia abjo como fecha anterior a la fecha inicial cuando deviera ser, en este caso, el primer valor inmediato anterior a la fecha inicial como se muestra en las imágenes.

Entonces lo que quisiera es encontrar una forma que la macro recoja el primer valor Inmediato anterior a la fecha inicial, es decir la fecha que está arriba de la fecha Inicio así como se ve en la primer imagen en relleno color verde. 

Ojala me puedeas ayudar sin querer abusar de tu tiempo. De antemano muchas gracias....

Ahhh este el el código para el ejemplo citado.

Private Sub btnConsulta_Click()
Sheets("Resumen").Activate
Set H1 = Sheets("Ventas")
Set H2 = Sheets("Resumen")

H2.Range("C3:F" & Rows.Count).ClearContents
Fecha1 = H1.[K8]
Fecha2 = H1.[K9]

j = 3
n = 0
For i = 10 To H1.Range("C" & Rows.Count).End(xlUp).Row
If H1.Cells(i, "C") >= Fecha1 And H1.Cells(i, "C") <= Fecha2 Then
H1.Range("C" & i & ":F" & i).Copy
H2.Range("C" & j).PasteSpecial xlValues
j = j + 1
n = n + 1
End If
Next

FechaAnterior = Fecha1 - 1
H2.[F2] = ""
H2.[D2] = ""
For i = 1 To 4
Set b = H1.Columns("C").Find(FechaAnterior, lookat:=xlWhole)
If Not b Is Nothing Then
H2.[F2] = H1.Cells(b.Row, "F")
H2.[D2] = H1.Cells(b.Row, "C")
Exit For
Else
FechaAnterior = FechaAnterior - 1
End If
Next

End Sub

Con mucho gusto te ayudo con todas tus peticiones.

Crea una nueva en el tema de microsoft excel. En el desarrollo de la pregunta escribe: "para Dante Amor". Ahí me describes con detalle lo que necesitas.

Sal u dos

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas