Añadir registros entre fechas excel
Quiero crear una especie de agenda en excel, tengo 3 hojas Inicio, Registro, Resultados.
La hoja Inicio tiene los campos que se ve en la imagen Fecha Inicio, Fecha Fin, Descripción, tipo. La idea es que al pulsar añadir, añada tantos registros sea necesario como días hay entre fechas, es decir en este ejemplo repita mirar correo todos los días entre el 4/10/22 hasta el 22/6/23 en la tabla que hay en la hoja Registros. El campo tipo era por si pudiera ser que si se elije laborables solo añada los registros que sean días laborales excluyendo sábados, domingos y festivos. Pero esto sino lo podría deducir luego en la tabla mediante fórmulas creo si es muy complicado.
Ej: 4/10/22 mirar correo
5/10/22 mirar correo
6/10/22 mirar correo
....
22/6/23 mirar correo
Y por ultimo en la hoja Resultados tengo estos campos:
La idea es elegir una fecha en la celda D5 y que esta se copie en C9 o directamente sobre esa fecha me traiga una lista de todas las tareas que haya en la tabla de la hoja registros para ese día elegido.
Por ejemplo suponemos que tengo estos registros en la tabla de la hoja registros:
La idea es que en resultados me mostrara esto:
Espero haber podido explicarme bien y gracias de antemano como siempre por su ayuda. Dejo enlace del ejemplo por si es mejor para visualizarlo https://www.transfernow.net/dl/20221004CabrIoZM .
1 Respuesta
Te invito a SUSCRIBIRTE a mi canal de YouTube:
Ahí encontrarás más sobre Excel y Macros:
https://www.youtube.com/channel/UCs644-v3ti4SF7zE_bt_YXA
Comparte los enlaces en tus redes sociales.
Es un requerimiento largo, pero te entrego todas las peticiones.
Pon tus fechas festivas en la celda G2 y hacia abajo.
La macro "insertar" verifica los días festivos, sábados y domingos, si escribes "Laborables".-
Pon la siguiente macro en un módulo:
Sub Insertar()
'Por Dante Amor
Dim sh As Worksheet
Dim i As Long, lr As Long, iRow As Long
Dim rng_festivos As Range, c As Range
Dim LstObj As ListObject
Dim addNew As Boolean
Dim fecN As Long, dia As Long
'
Set sh = Sheets("Inicio")
'Establecemos un objeto para la Tabla1
Set LstObj = Sheets("Registros").ListObjects("Tabla1")
'Establecemos un rango para los días festivos
lr = sh.Range("G" & Rows.Count).End(3).Row
If lr > 1 Then
Set rng_festivos = sh.Range("G2:G" & lr)
End If
'
'VALIDACIONES
If sh.Range("C6").Value = "" Or sh.Range("C8").Value = "" Or sh.Range("C10").Value = "" Or _
Not IsDate(sh.Range("C6").Value) Or Not IsDate(sh.Range("C8").Value) Then
MsgBox "Revisa los datos"
Exit Sub
End If
If sh.Range("C6").Value > sh.Range("C8").Value Then
MsgBox "La fecha inicial es mayor a la final, corregir las fechas"
Exit Sub
End If
'
For i = sh.Range("C6").Value To sh.Range("C8").Value
addNew = True
If sh.Range("C12").Value = "Laborables" Then
'días festivos
fecN = i & ""
For Each c In rng_festivos
dia = c.Value
If dia = fecN Then
addNew = False
End If
Next
'sábados y domingos
If Weekday(i, vbMonday) = 6 Or Weekday(i, vbMonday) = 7 Then
addNew = False
End If
End If
If addNew = True Then
LstObj.ListRows.Add AlwaysInsert:=True
iRow = LstObj.DataBodyRange.Rows.Count
LstObj.DataBodyRange(iRow, 2).Value = i 'fecha
LstObj.DataBodyRange(iRow, 3).Value = sh.Range("C10").Value 'desc
LstObj.DataBodyRange(iRow, 4).Value = sh.Range("C12").Value 'tipo
End If
Next
'
MsgBox "Fechas copiadas"
End SubPon el siguiente código en los eventos de la hoja "Resultados"
Private Sub Worksheet_Change(ByVal Target As Range)
'Por Dante Amor
If Target.Count > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub
'
Dim shR As Worksheet
Dim fec As String
Dim lr As Long
'
Application.ScreenUpdating = False
'
Set shR = Sheets("Registros")
'
If Target.Address(0, 0) = "D5" Then
Range("C10:E" & Rows.Count).ClearContents
fec = Format(Target.Value, "mm/dd/yyyy")
'filtra los valores que cumplen con la fecha
shR.ListObjects("Tabla1").Range.AutoFilter Field:=2, _
Operator:=xlFilterValues, Criteria2:=Array(2, fec)
lr = shR.Range("C:C").Find("*", , xlValues, xlWhole, xlByRows, xlPrevious).Row
If lr > 5 Then
'los copia de Registros a Resultados
shR.Range("C6:E" & lr).Copy
Range("C10").PasteSpecial xlPasteValues
Else
MsgBox "No existen registros con esa fecha"
End If
shR.ListObjects("Tabla1").Range.AutoFilter
Range("D5").Select
End If
Application.ScreenUpdating = True
End SubTe comparto el archivo.
https://docs.google.com/spreadsheets/d/1VePC2pDtZNXQMu4JqHi-WQGCEpffimr1/edit?usp=sharing&ouid=103060997651612915482&rtpof=true&sd=true
Comparte los enlaces en tus redes sociales.
sal u dos
Muchísimas gracias como siempre, ya lo he visto y funciona correctamente, he probado añadir dos campos más a la hoja de inicio Hora Inicio y Hora Fin y he conseguido modificar la macro para que me los añada en la hoja de registros:
If addNew = True Then
LstObj.ListRows.Add AlwaysInsert:=True
iRow = LstObj.DataBodyRange.Rows.Count
LstObj.DataBodyRange(iRow, 2).Value = i 'fecha
LstObj.DataBodyRange(iRow, 3).Value = sh.Range("C10").Value 'desc
LstObj.DataBodyRange(iRow, 4).Value = sh.Range("C12").Value 'tipo
LstObj.DataBodyRange(iRow, 5).Value = sh.Range("C14").Value ' Hora inicio
LstObj.DataBodyRange(iRow, 6).Value = sh.Range("C16").Value ' Hora Fin
End If
No se si sería la forma correcta, aunque funcione. También he conseguido traerlos los resultados modificando los rangos a la hoja de resultados.
Mi pregunta ultima es, ¿si cambio nombre de hoja o tabla se modifica directamente en las macros? Y como puedo mover los festivos a una hoja nueva por ejemplo Configuración y que haga resfencia a ella para buscar los festivos en lugar de tenerlos en la hoja inicio.
Ya me he suscrito a tu canal y lo compartiré por mis redes sociales.
Muchas gracias por adelantado como siempre.
Un saludo
Si cambias el nombre de la hoja o de la tabla, debes actualizar la macro.
Normalmente se ponen los datos de la hoja al inicio de la macro, para que sea más fácil de identificar y cambiar:
Set sh = Sheets("Inicio")
'Establecemos un objeto para la Tabla1
Set LstObj = Sheets("Registros").ListObjects("Tabla1")Para cambiar los festivos de hoja o de columna:
'Establecemos un rango para los días festivos
lr = sh.Range("G" & Rows.Count).End(3).Row
If lr > 1 Then
Set rng_festivos = sh.Range("G2:G" & lr)
End IfCambia sh por la hoja de configuración y cambia "G" por la columna.
Por ejemplo:
dim shC as worksheet
set shC = sheets("Configuracion")
'Establecemos un rango para los días festivos
lr = shC.Range("A" & Rows.Count).End(3).Row
If lr > 1 Then
Set rng_festivos = sh.Range("A2:A" & lr)
End IfGra cias por suscribirte a mi canal y compartirlo.
Hola he intentado cambiar como me dijiste par cambiarlo de hoja pero no he sido capaz, he creado la hoja Configuración y en la columna B he puesto los festivos.
dim shC as worksheet
set shC = sheets("Configuracion")
'Establecemos un rango para los días festivos
lr = shC.Range("B" & Rows.Count).End(3).Row
If lr > 1 Then
Set rng_festivos = sh.Range("B9:B" & lr)
End IfPero no me deja añadir nuevos registros me da errores de variables no definidas y no doy con ello. Te adjunto el archivo para ver si puedes ver que hago mal ya que tiene modificaciones respecto al primero https://we.tl/t-GYpd6HT0Np y este en version zip por si te diera problemas para descargarlo https://we.tl/t-YhSzHXNcbB.
Gracias como siempre de antemano
Un saludo
En configuración solamente debes poner los días festivos.
Los días sábado y domingo la macro ya los considera en estas líneas:
'sábados y domingos If Weekday(i, vbMonday) = 6 Or Weekday(i, vbMonday) = 7 Then addNew = False End If
Muchísimas gracias ese fue mi error, añadir sábados y domingos donde estaban los días festivos al quitarlo funciona correctamente.
Todo funciona correctamente como siempre. Muy agradecido le estoy.
Un saludo
Si alguien más está interesado en temas de Excel, puedes recomendar mi canal:
