Macro para rellenar con secuencia de fechas hacia atrás y hacia adelante
Dam, por favor; en esta oportunidad requiero rellenar una secuencia de fechas como se muestran en la imagen de fondo amarillo partiendo de la celda "F29" que correspondería a la fecha actual, se deben tener en cuenta los siguientes aspectos:
- En el rango de la columna "S" se relacionan los días festivos.
- Los días hábiles de trabajo van de Lunes a Viernes únicamente.
- Se han colocado dos pares de fechas de color rosado, porque en la primera pareja entre el 06/08/2015 y el 10/08/2015 cabría el 07/08/2015, pero esa fecha a pesar que cayó en viernes corresponde a un día festivo, la misma razón cabe entre el 14/08/2015 y 18/08/2015, pues a pesar que el 17/08/2015 cayó en Lunes, ese día es festivo.
- En la celda "F29" debe colocarse la fecha del día en que se ejecuta la macro, en éste caso el día de hoy "31/08/2015"; de allí se debe avanzar y retroceder en el rango de fechas.
Quedo pendiente de cualquier duda adicional que tengas para poder ayudarme.
DAM, para hallar la fecha de inicio uso la siguiente formula:
=DIA.LAB(F29;-20;S17:S34)
La fecha Final se determina por la siguiente fórmula:
=DIA.LAB(R39;30;S17:S34)
La secuencia es para retroceder "F28:F20" ; "B33:B31" y "B27:B20"
Y hacia adelante es: "K20:K29"
Es que como las celdas no son continúas sino que se interrumpen, esa es mi principal dificultad.
Muchas gracias por tu ayuda.
DAM, disculpas, la fórmula que utilizo para hallar la fecha inicial o sea la de la celda "B20", es la siguiente:
=DIA.LAB(F29;-20;S17:S34)
¿Pero la fecha de inicio siempre va a ser en F29? ¿Y de ahí hacia atrás y de ahí hacia adelante?
Dam, efectivamente la fecha cero, por decirlo de alguna forma, siempre será la de la celda "F29"
Necesito que me confirmes si la celda inicial es la F29.
Sí señor.
Te voy a poner una duda a la vez, para que no des más información de la necesaria.
Ahora dime los rangos de celdas hacia atrás.
La secuencia para retroceder "F28:F20" ; "B33:B31" y "B27:B20"
Y hacia adelante es: "K20:K29"
Ho l a:
Te anexo la macro
Sub PonerFechas()
'Por.Dante Amor
[F29] = Date
'
'Reversa
rangos = Array("F20:F28", "B31:B33", "B20:B27")
'
n = 1
For j = LBound(rangos) To UBound(rangos)
Set r1 = Range(rangos(j))
i = r1.Cells(1, 1).Row
f = r1.Cells(r1.Rows.Count, 1).Row
col = r1.Cells(1, 1).Column
For c = f To i Step -1
Cells(c, col) = Date - n
Do While True
If Weekday(Cells(c, col), 2) > 5 Then
n = n + 1
Cells(c, col) = Date - n
Else
Set b = Columns("S").Find(Cells(c, col), lookat:=xlWhole)
If b Is Nothing Then
n = n + 1
Exit Do
Else
n = n + 1
Cells(c, col) = Date - n
End If
End If
Loop
Next
Next
'
'Adelante
rangos = Array("K20:K29")
n = 1
For j = LBound(rangos) To UBound(rangos)
Set r1 = Range(rangos(j))
i = r1.Cells(1, 1).Row
f = r1.Cells(r1.Rows.Count, 1).Row
col = r1.Cells(1, 1).Column
For c = i To f
Cells(c, col) = Date + n
Do While True
If Weekday(Cells(c, col), 2) > 5 Then
n = n + 1
Cells(c, col) = Date + n
Else
Set b = Columns("S").Find(Cells(c, col), lookat:=xlWhole)
If b Is Nothing Then
n = n + 1
Exit Do
Else
n = n + 1
Cells(c, col) = Date + n
End If
End If
Loop
Next
Next
MsgBox "Fechas terminadas"
End SubSolamente cuida que el formato de fecha de los rangos sea igual al formato de fecha que tienes en los días festivos.
‘
S a l u d o s . D a n t e A m o r. Recuerda valorar la respuesta. G r a c i a s
DAM, muchas gracias; es una lástima que esta sea la calificación máxima y como siempre tu aporte es muy excelente, ágil y concreto.
Saludos.
