Autor Tema: Crear Funcion para detectar Jueves y Viernes Santo  (Leído 155 veces)

0 Usuarios y 1 Visitante están viendo este tema.

antonio2005pe

  • Bytes
  • *
  • Mensajes: 48
  • Reputación: +0/-1
    • Ver Perfil
Crear Funcion para detectar Jueves y Viernes Santo
« en: Mayo 03, 2022, 01:26:41 am »
Estimados, por favor si alguien sabria como detectar el Jueves y Viernes Santo de cada año?, porque las fechas varian cada año y a veces cambia tambien con los años bisiestos, no tengo ni como verificar dichas fechas, lo quiero para detectar los dias feriados que caen en esas fechas, algo como esto:

Private Function CompJuevesyViernesSanto (Fecha as string) as Boolean
        If Fecha = "JuevesSanto?" or Fecha = "ViernesSanto?" Then
               CompJuevesyViernesSanto = True
        Else
               CompJuevesyViernesSanto = False
        End If
End Function

donde "?" es como comprobar dichas fechas ya que es variable cada año.

Saludos,

LeandroA

  • Administrador
  • Petabyte
  • *****
  • Mensajes: 1111
  • Reputación: +150/-8
    • Ver Perfil
Re:Crear Funcion para detectar Jueves y Viernes Santo
« Respuesta #1 en: Mayo 04, 2022, 04:25:02 am »
Interesante pregunta, por lo que leí esta es la lógica
Citar
La Pascua de Resurrección es el domingo inmediatamente posterior a la primera Luna llena tras el equinoccio de marzo y se debe calcular empleando para el cálculo la Luna llena astronómica. Puede ocurrir no antes del 22 de marzo y el 25 de abril como muy tarde.   
Así que la pregunta es cómo obtener las fauces lunares, voy a leer un poco haber si puedo encontrar algo.

LeandroA

  • Administrador
  • Petabyte
  • *****
  • Mensajes: 1111
  • Reputación: +150/-8
    • Ver Perfil
Re:Crear Funcion para detectar Jueves y Viernes Santo
« Respuesta #2 en: Mayo 04, 2022, 07:05:46 am »
bueno ahi creo que anduvo, encontré una rutina sencilla para calcular la fase lunar y con un bucle recorro 22 de marzo hasta el  25 de abril  y cuando encuentra la luna llena busca el siguiente jueves, testie un par de fecha y concedieron bien la función es GetJuevesSanto() luego el viernes es fácil ya que solo hay que sumar un día, y después arme tu función tal como la pediste.

Código: [Seleccionar]
Option Explicit



Private Sub Form_Load()

    Debug.Print CompJuevesyViernesSanto("12/01/2022") 'no
   
    Debug.Print CompJuevesyViernesSanto("28/3/2013") 'si 'jueves santo
   
    Debug.Print CompJuevesyViernesSanto("18/4/2014") 'si 'viernes santo
   
    Debug.Print CompJuevesyViernesSanto("14/4/2022") 'si 'jueves santo
   
End Sub


Private Function CompJuevesyViernesSanto(ByVal Fecha As Date) As Boolean
    Dim FechaJuevesSanto As Date
    Dim FechaViernesSanto As Date
   
    FechaJuevesSanto = GetJuevesSanto(year(Fecha))
    FechaViernesSanto = FechaJuevesSanto + 1
   
    If Fecha = FechaJuevesSanto Or Fecha = FechaViernesSanto Then
        CompJuevesyViernesSanto = True
    Else
        CompJuevesyViernesSanto = False
    End If
End Function

Private Function GetJuevesSanto(Año As Integer) As Date
    Dim i As Long
    Dim xDate As Date
    Dim bFindFoolMoon As Boolean

    xDate = "22/03/" & Año
    For i = 1 To 34
        If GetMoonPhase(year(xDate), month(xDate), day(xDate)) = 4 Then
            bFindFoolMoon = True
        End If
       
        If bFindFoolMoon = True Then
            If DatePart("w", xDate) = vbThursday Then
                GetJuevesSanto = xDate
                Exit Function
            End If
        End If
       
        xDate = xDate + 1
    Next
End Function


Function GetMoonPhase(year, month, day)

    Dim c, e, jd, b

    If (month < 3) Then
        year = year - 1
        month = month + 12
    End If

    month = month + 1

    c = 365.25 * year

    e = 30.6 * month

    jd = c + e + day - 694039.09  '//jd is total days elapsed

    jd = jd / 29.5305882 '//divide by the moon cycle

    b = CInt(jd) '//int(jd) -> b, take integer part of jd

    jd = jd - b '//subtract integer part to leave fractional part of original jd

    b = Round(jd * 8) '//scale fraction from 0-8 and round

    If (b >= 8) Then
        b = 0 '//0 and 8 are the same so turn 8 into 0
    End If

    '// 0 => New Moon
    '// 1 => Waxing Crescent Moon
    '// 2 => Quarter Moon
    '// 3 => Waxing Gibbous Moon
    '// 4 => Full Moon
    '// 5 => Waning Gibbous Moon
    '// 6 => Last Quarter Moon
    '// 7 => Waning Crescent Moon
   
    GetMoonPhase = b
End Function
« última modificación: Mayo 04, 2022, 07:07:33 am por LeandroA »

antonio2005pe

  • Bytes
  • *
  • Mensajes: 48
  • Reputación: +0/-1
    • Ver Perfil
Re:Crear Funcion para detectar Jueves y Viernes Santo
« Respuesta #3 en: Mayo 13, 2022, 11:19:07 am »
bueno ahi creo que anduvo, encontré una rutina sencilla para calcular la fase lunar y con un bucle recorro 22 de marzo hasta el  25 de abril  y cuando encuentra la luna llena busca el siguiente jueves, testie un par de fecha y concedieron bien la función es GetJuevesSanto() luego el viernes es fácil ya que solo hay que sumar un día, y después arme tu función tal como la pediste.

Código: [Seleccionar]
Option Explicit



Private Sub Form_Load()

    Debug.Print CompJuevesyViernesSanto("12/01/2022") 'no
   
    Debug.Print CompJuevesyViernesSanto("28/3/2013") 'si 'jueves santo
   
    Debug.Print CompJuevesyViernesSanto("18/4/2014") 'si 'viernes santo
   
    Debug.Print CompJuevesyViernesSanto("14/4/2022") 'si 'jueves santo
   
End Sub


Private Function CompJuevesyViernesSanto(ByVal Fecha As Date) As Boolean
    Dim FechaJuevesSanto As Date
    Dim FechaViernesSanto As Date
   
    FechaJuevesSanto = GetJuevesSanto(year(Fecha))
    FechaViernesSanto = FechaJuevesSanto + 1
   
    If Fecha = FechaJuevesSanto Or Fecha = FechaViernesSanto Then
        CompJuevesyViernesSanto = True
    Else
        CompJuevesyViernesSanto = False
    End If
End Function

Private Function GetJuevesSanto(Año As Integer) As Date
    Dim i As Long
    Dim xDate As Date
    Dim bFindFoolMoon As Boolean

    xDate = "22/03/" & Año
    For i = 1 To 34
        If GetMoonPhase(year(xDate), month(xDate), day(xDate)) = 4 Then
            bFindFoolMoon = True
        End If
       
        If bFindFoolMoon = True Then
            If DatePart("w", xDate) = vbThursday Then
                GetJuevesSanto = xDate
                Exit Function
            End If
        End If
       
        xDate = xDate + 1
    Next
End Function


Function GetMoonPhase(year, month, day)

    Dim c, e, jd, b

    If (month < 3) Then
        year = year - 1
        month = month + 12
    End If

    month = month + 1

    c = 365.25 * year

    e = 30.6 * month

    jd = c + e + day - 694039.09  '//jd is total days elapsed

    jd = jd / 29.5305882 '//divide by the moon cycle

    b = CInt(jd) '//int(jd) -> b, take integer part of jd

    jd = jd - b '//subtract integer part to leave fractional part of original jd

    b = Round(jd * 8) '//scale fraction from 0-8 and round

    If (b >= 8) Then
        b = 0 '//0 and 8 are the same so turn 8 into 0
    End If

    '// 0 => New Moon
    '// 1 => Waxing Crescent Moon
    '// 2 => Quarter Moon
    '// 3 => Waxing Gibbous Moon
    '// 4 => Full Moon
    '// 5 => Waning Gibbous Moon
    '// 6 => Last Quarter Moon
    '// 7 => Waning Crescent Moon
   
    GetMoonPhase = b
End Function
La verdad es que no tenia ni la menor idea de como comprobar esas fechas, solo sabia que era entre Marzo y Abril y como eran variables y varian tambien por los años bisiestos.
Muchas Gracias,
Salu2