¿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
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.
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
- Compartir respuesta