Calender 6 semanas

[Alexrr]

Buenas ..
Tengo un Calendario de 6 semanas y al cambiar la fecha celda "C5" me da un nuevo agenda, notar que el 1 de enero del 2019 cae en la celda "E8" que es el día martes. El primer día de cada año varia dependiendo del año por ejemplo: 2020 cae el día miércoles "F8".
Lo que necesito es:
1- Formatear de modo que borre los días anteriores al año (2019 celdas "D7" hasta "D8") y al final del año (2019 celdas "AH16" hasta "AS16")

2- Marcar el primer día de cada mes ... por ejemplo 1 de enero 2019 seria: 1/1, 1 de Feb 2019 seria: 2/1, 1 de Marzo seria: 3/1, actualmente los meses se differencian de color amarillo y blanco

3- Poder cambiar que el Calendario (el 1 día de cada año) pueda empezar en la 1 semana, segunda, tercera semana, hasta la sexta semana. Utilizar la celda "C6" para este objetivo. ejemplo: Si pongo en la celda "C6" 4 cuarta semana, debería el Calendario empezar en la cuarta semana celda "Z8" para el año 2019

schemmaexcel

 

[hernantorres23]

Cita: "También me soluciona otro problema que era cuando tengo esquemas de trabajo de 4-6-8 semanas,..."
Estaba seguro que era para eso, y por ello, agregue lo de las semanas. Lo que no sabía es que tenías tres tipos de rotación. En verdad, se me ocurrieron muchas cosas con ese archivo, pues tengo mucha experiencia con los Payroll, hasta he creado un sistema . Hay muchas cosas que puedes automatizar en esa hoja.

También entiendo que si tus ciclos están bien realizados, se forma un bucle una vez que finalizan; además que con un grupo, cubres el descanso de otro grupo.

Entonces entiendo, lo que deseas es ubicar los grupos de trabajo (para tu propósito son esquemas). Por ello cuando te respondí, que no le veía sentido al tercer requerimiento, es sencillamente porque en el código que te dejé, y por naturaleza propia, el día miércoles 01 de enero de 2020, siempre es miércoles independientemente de la semana.

Ahora bien, para concluir la idea sobre lo que entiendo, lo único que tú deseas es mantener el número de la semana en tu ciclo, ejemplo: suponiendo que el grupo de trabajado N°6 está en la cuarta (4) semana de su ciclo al 31-dic-2019, que es un día martes, implicaría durante la primera semana calendario del 2020, debe mantener ese ciclo, incluso continuar. Esto quiere decir, que la semana 4 del esquema 6 (grupo N° 6, para mí) podría ser la semana 3 de otro grupo, la semana 2 de otro, etc.

Sí, es lo que que expuse en el último párrafo, sólo tienes que reorientar un poco la idea, pero considerando precisamente, tus esquemas en esos bucles.

Estoy a la orden, y aún no respondes de donde eres.

Mikel ERP
Maracaibo, Venezuela.

 

[Alexrr]

Espero que esto te aclare más mi idea, esto lo utilizaba para hacer el calendario en nuestro esquema de trabajo.

(Foto 1) 2018- El último día del calendario en el esquema de trabajo es el lunes 31- diciembre semana 8.

Entonces el calendario para el 2019 debe empezar el martes 1 - enero semana 8 (Foto 2)....

El calendario de trabajo del 2019 termina el martes 31- diciembre semana 6.

El calendario para el 2020 debe empezar el miércoles 1- enero semana 6 y termina el año en la semana 4

 

[Alexrr]

Dropbox - File Deleted - Simplify your life

www.dropbox.com

Dropbox - File Deleted - Simplify your life

www.dropbox.com

Dropbox - File Deleted - Simplify your life

www.dropbox.com

 

[Alexrr]

Me llamo Alex soy sueca.

 

[hernantorres23]

Muy bien Alex, eres mi primera amiga Sueca, mucho gusto, mi nombre es Hernan. He visto las tres imágenes, y por eso te hago la algunas preguntas:

• Como asignas el horario a cada persona?
• Aparte de la tabla que se ve en las imágenes, tienes una tabla de horarios detallada?
• En algún caso, utilizas las 52 semanas? te pregunto eso porque ahora veo nueve (9) semanas, y en tus ejemplos previos solo seis (6)
• Cual es tu intención real con todo este archivo?
• Guardas un histórico del año en una hoja del libro Excel?

Seria ideal, si pudieras, enviarme un archivo *.xls, tal cual la fotos, para evaluar todo el escenario con tus formulas y ayudarte mas puntualmente.
Lo que me planteas es precisamente, lo que entendí, pero teniendo tu libro, quizás, puedo agregar mas automatización a tu hoja.

Espero tu respuesta.

Saludos , Hernan (Mikel ERP)

 

[Alexrr]

Hola Hernan ..por diferencias de horario ya estaba en la camita cuando tu respondio. Ahora te respondo..... puedes ver en el archivo que te mando..muchas gracias por tu ayuda...

Dropbox - File Deleted - Simplify your life

www.dropbox.com

 

[hernantorres23]

Hola Hernan ..por diferencias de horario ya estaba en la camita cuando tu respondio. Ahora te respondo..... puedes ver en el archivo que te mando..muchas gracias por tu ayuda...

Hola no te preocupes, lo importante es no perder el hilo del trabajo. Justo estaba trabajando en base a lo que tenia, con ocho (8) semanas y todo bien, ahora observare tu archivo, para ver si voy bien . Apenas tenga un adjunto listo, escribo de nuevo.

Saludos , Hernan (Mikel ERP)

 

[hernantorres23]

Hola Alex, aquí te dejo otro aporte

Para probar puedes:

23/11/2019

• Cambiar el numero en rQtySemanas
• Cambiar la fecha en rStartDate
• No hace falta el numero en rNumWeeks

24/11/2019

• He tenido que anclar un año base, que coincida con tus semanas, para incrementar/iniciar tomando esa posición. Me he basado en las imágenes, para este fin

25/11/2019

• He creado un código para funcionar con ocho (8) semanas, la verdad no probé si funciona con las otras variantes (4 y 6), pero la idea esta plasmada
• He limpiado un poco el código, y te dejo solo algunos comentarios
• El valor inicial de "firstDayInCalendar" para poder crear el año 2019 debe ser 54 (considere las imágenes recibidas por ti) y los calendarios sucesivos deben ir en orden, si tienes dudas, con esto, me escribes

... y presiona el botón OK.

Como te comento en el archivo adjunto, para iniciar es importante configurar, cuando se ordenaron esas semanas por cada grupo de trabajo. De verdad, que hay muchas formas, puedes tener un *.txt en algún lugar de tu red, PC, etc. para leer la ultima configuración de cada grupo. Con eso te aseguras errores, pero si lo hicieras contra una base de datos no tendrías ese problema; de momento guardo la configuración como un nombre (firstDayInCalendar) en el libro.

Aun se puede hacer mucho mas, luego veré tu archivo, pero cuéntame que te han parecido, los cambios que he realizado al código anterior

Saludos , Hernan (Mikel ERP)

'Calendario continuado en Excel by htorres - Mikel ERP
'November 25, 2019
'Maracaibo , Venezuela

Option Explicit
Private finBucle As Integer     'para detener el bucle cuando termine de dibujar los dias

'Nota: variables iniciadas con 'p' significan parametros (pBaseYear, pLastWeek, etc.)

Sub SetCalContHernan()

Const rStartDate As String = "C5"
Const Color1 As Long = 13434879
Const Color2 As Long = 16382457
Const Color3 As Long = 14869218
Const rDiasSem As Integer = 7       'se conoce pero para controlar los parametros la dejo aqui
'Const pBaseYear As Integer = 2018      'el año base, puede cambiarlo a tu gusto, solo le di un uso pero ahora puedes descartarla

Dim i As Integer, fillColor As Long
Dim d As Integer
Dim l As Integer                    'para mi esto representa la cantidad de filas en las que deseas tener tu calendario
Dim oStartDate As Range
Dim rSemanas As Integer             'Columnas de semana
Dim pStartWeek As Integer
Dim pCalendarWidth As Integer
Dim wColumnas As Integer
Dim pLastDay As Integer
Dim pColumna As Integer
Dim inicioCalendario As Integer     'la posicion inicial del calendario
Dim letraColumna As String          'solo para efeectos de prueba
Dim evaluatedYear As Integer
Dim myFlag As Integer
Dim daysWritten As Integer
    
Application.ScreenUpdating = False  'esto debe ir al principio, despues de la declaracion de las variables
 
rSemanas = Range("rQtySemanas")    'puedes dirigir esto hacia una celda
pStartWeek = 2  'puedes asignar esto a una celda. Asigno 2 para que inicie en Lunes

    
If IsDate(Range(rStartDate)) Then
    Set oStartDate = Range(rStartDate) 'tengo que revisar el formato de esta fecha
    evaluatedYear = makeCalendar(rSemanas, Year(oStartDate), bisiesto(Year(oStartDate)))
    
Else
    MsgBox "Invalid Start Date"
    Exit Sub
End If

Range("semanas").Select
With Selection
    .ClearContents
    .Interior.Pattern = xlNone
End With

'pColumna la necesito para saber cuantas filas me va a tomar el calendario
pColumna = Val(Replace(ThisWorkbook.Names.Item("firstDayInCalendar"), "=", ""))
'Esta sentencia deberia ser para colocar los encabezados de las columnas
'---CREANDO LOS ENCABEZADOS---
Range(oStartDate.Address).Offset(1, 1).Activate 'tomar una posicion para construir el calendario
'ActiveCell.Offset(1, 1).Activate
pCalendarWidth = (rDiasSem * rSemanas) - 1

For i = 0 To pCalendarWidth
    'si deseas que tu calendario inicie con el dia de semana correspondiente
    'puedes extender la idea que viene en la siguiente linea de codigo
    'ActiveCell.Offset(0, i) = StrConv(Left(Format(Weekday(oStartDate + i, 2), "ddd"), 1), 1)
    ActiveCell.Offset(0, i) = StrConv(Left(Format(Weekday(oStartDate - Weekday(oStartDate, 2) + i + 2, 2), "ddd"), 1), 1)
Next i

'---ESCRIBIR UN CALENDARIO CON SEIS SEMANAS ANTES DE CADA SALTO---
'calcular las lineas ncesarias para completar
'el calendario hasta el 31-dic de cada año
'considerando las semanas requeridas

l = 0 'esta modificacion que propones, finalmente me da la posibilidad de nombrar esto a lineas (variable "l")
While pLastDay < finBucle
'---ESCRIBIR LOS DIAS---
l = l + 1
    Select Case l
    Case 1 'si estamos en la primera semana del rango
    inicioCalendario = Range(oStartDate.Address).Column
    Range(oStartDate.Address).Offset(2, pColumna - inicioCalendario).Activate 'cambie esto para colocar lo que me pediste (iniciar en la columna siguiente a donde finalizo el año anterior)
    wColumnas = pCalendarWidth - (pColumna - 1) + inicioCalendario
    
    For d = 0 To wColumnas
        If Day(oStartDate + d) = 1 Then
        'MsgBox "estoy en dia 1"
        ActiveCell.Offset(0, d) = oStartDate + d
        ActiveCell.Offset(0, d).NumberFormat = "m/d"
        ActiveCell.Offset(0, d).Interior.Color = Color1
        ActiveCell.Offset(0, d).Font.Bold = True
        ActiveCell.Offset(0, d).Font.Name = "Arial"
        ActiveCell.Offset(0, d).Font.Size = 8
        ActiveCell.Offset(0, d).HorizontalAlignment = xlCenter
        ActiveCell.Offset(0, d).VerticalAlignment = xlCenter
        Else
        ActiveCell.Offset(0, d) = oStartDate + d
        ActiveCell.Offset(0, d).NumberFormat = "d"
        ActiveCell.Offset(0, d).Interior.Color = Color2
        ActiveCell.Offset(0, d).Font.Bold = False
        ActiveCell.Offset(0, d).Font.Name = "Arial"
        ActiveCell.Offset(0, d).Font.Size = 8
        ActiveCell.Offset(0, d).HorizontalAlignment = xlCenter
        ActiveCell.Offset(0, d).VerticalAlignment = xlCenter
        End If
        
        'por si un dia se te ocurre pintar los feriados
        If ((Weekday(oStartDate + d, 2) = 6 Or Weekday(oStartDate + d, 2) = 7) And Day(oStartDate + d) <> 1) Then
        'MsgBox "estoy en fin de semana"
        ActiveCell.Offset(0, d).Interior.Color = Color3
        ActiveCell.Offset(0, d).Font.Color = vbRed
        ActiveCell.Offset(0, d).Font.Bold = True
        End If
                
'        si quieres pintar los meses
'        If Month(oStartDate + d) Mod 2 Then
'        ActiveCell.Offset(0, d).Interior.Color = Color1
'        Else
'        ActiveCell.Offset(0, d).Interior.Color = Color2
'        End If
    Next d
        
    Case Else
    Range(oStartDate.Address).Offset(2 + l - 1, 1).Activate 'no te confundas, la operacion es: 2 + L minuscula - 1
    
    For d = 0 To pCalendarWidth
        If Day(oStartDate + pLastDay) = 1 Then
        ActiveCell.Offset(0, d) = oStartDate + pLastDay
        ActiveCell.Offset(0, d).NumberFormat = "m/d"
        ActiveCell.Offset(0, d).Interior.Color = Color1
        ActiveCell.Offset(0, d).Font.Bold = True
        ActiveCell.Offset(0, d).Font.Name = "Arial"
        ActiveCell.Offset(0, d).Font.Size = 8
        ActiveCell.Offset(0, d).HorizontalAlignment = xlCenter
        ActiveCell.Offset(0, d).VerticalAlignment = xlCenter
        Else
        ActiveCell.Offset(0, d) = oStartDate + pLastDay
        ActiveCell.Offset(0, d).NumberFormat = "d"
        ActiveCell.Offset(0, d).Interior.Color = Color2
        ActiveCell.Offset(0, d).Font.Bold = False
        ActiveCell.Offset(0, d).Font.Name = "Arial"
        ActiveCell.Offset(0, d).Font.Size = 8
        ActiveCell.Offset(0, d).HorizontalAlignment = xlCenter
        ActiveCell.Offset(0, d).VerticalAlignment = xlCenter
        End If
        
        'por si un dia se te ocurre pintar los feriados
        If ((Weekday(oStartDate + pLastDay, 2) = 6 Or Weekday(oStartDate + pLastDay, 2) = 7) And Day(oStartDate + pLastDay) <> 1) Then
        'MsgBox "estoy en fin de semana"
        ActiveCell.Offset(0, d).Interior.Color = Color3
        ActiveCell.Offset(0, d).Font.Color = vbRed
        ActiveCell.Offset(0, d).Font.Bold = True
        End If
        
'        si quieres pintar los meses
'        If Month(oStartDate + pLastDay) Mod 2 Then
'        ActiveCell.Offset(0, d).Interior.Color = Color1
'        Else
'        ActiveCell.Offset(0, d).Interior.Color = Color2
'        End If
        pLastDay = pLastDay + 1
    Next d
    End Select
    
    Select Case l
    Case 1
    pLastDay = d
    daysWritten = wColumnas + 1
    'Debug.Print daysWritten
    
    Case Else
    pLastDay = pLastDay
    daysWritten = daysWritten + (pCalendarWidth + 1)
    'Debug.Print daysWritten
    
    If myFlag = 1 Then GoTo finalizar
    If pCalendarWidth >= (finBucle - daysWritten) Then
        'bajo la bandera
        myFlag = 1
        'reescribo pCalendarWidth
        pCalendarWidth = finBucle - daysWritten - 1
        'tomar la ultima posicion del año, para poder pasarla como inicial en el siguiente calendario
        ActiveWorkbook.Names.Add "firstDayInCalendar", , , , , , , , , ActiveCell.Offset(0, pCalendarWidth + 1).Column
        'letraColumna = Split(Cells(1, columna).Address, "$")(1) 'solo para validar
    End If
    
    End Select
Wend
  
    
finalizar:
Range("C15").Activate
Application.ScreenUpdating = True 'debemos devolver el estado a True
MsgBox "Calendario creado!!!", vbInformation, "Mikel ERP by htorres"
End Sub

Public Function bisiesto(anio As Integer)
Dim mesFeb As Date
Dim mesEvaluado As Integer

mesFeb = DateValue(Format("03/01/" & anio, "mm/dd/yyyy"))
mesEvaluado = Day(Application.EoMonth(mesFeb, -1))

If mesEvaluado = 28 Then
bisiesto = 365
finBucle = bisiesto
Else
bisiesto = 366
finBucle = bisiesto
End If
End Function


Public Function makeCalendar(semanas As Integer, anio As Integer, tipoAnio As Integer) As Integer
'para crear mas funcionalidad
Select Case semanas
Case 4
MsgBox "Creando calendario de 4 semanas", vbInformation, "Mikel ERP by htorres"
Case 6
MsgBox "Creando calendario de 6 semanas", vbInformation, "Mikel ERP by htorres"
Case Else '8 semanas
MsgBox "Creando calendario de 8 semanas" & Chr(10) & _
       "para el año " & anio, vbInformation, "Mikel ERP by htorres"
End Select

End Function

 

[hernantorres23]

Te adjunto otro archivo:::
Propuesta 8 semanas