Saltar al contenido

Fórmula para calcular los años bisiestos


pegones1

Recommended Posts

publicado

Para calcular los años bisiestos uso esta fórmula que me dice que los años de 366 días puedo ganar más dinero que los que tienen un día menos:

=REDONDEAR(MONEDA("4/"&A1)-MONEDA("4/"&A1-1);0)=366[/CODE]

En A1 el número con el año a comprobar si es bisiesto en que la fórmula anterior dará un valor VERDADERO.

publicado

Así es, Elías. Falla en los anteriores a 1901

La que parece más segura, aunque un poco larga, es:

=SI(O(RESIDUO(B4;400)=0;Y(RESIDUO(B4;4)=0;RESIDUO(B4;100)<>0));"Bisiesto";"No bisiesto")

Un saludos

publicado

Creo que se puede recortar un poco.

 
=SI((RESIDUO(B4;400)=0)+(RESIDUO(B4;4)=0)*(RESIDUO(B4;100)<>0);"";"No ")&"Bisiesto"
[/CODE]

Saludos

publicado

Hola friends:

Yo a lo mío,......jejeje

Public Function ESBISIESTO(Año As Range) As Boolean   

ESBISIESTO = False

If Año.Cells.Count > 1 Then
Beep
Exit Function
End If

If IsNumeric(Año.Value) = False Then
Beep
Exit Function
End If

r100 = Año.Value Mod 100
r1000 = Año.Value Mod 1000
r4 = Año.Value Mod 4

If r4 = 0 And (r100 > 0 Or r1000 = 0) Then
ESBISIESTO = True
End If

End Function


[/CODE]

Fórmula: (Devuelve Verdadero/Falso)

[CODE][B]=[COLOR=#b22222]ESBISIESTO[/COLOR]([COLOR=#0000ff][I]A1[/I][/COLOR])[/B][/CODE]

Saludos

publicado

Macro, ¡tenías que hacer de las tuyas!. Mira que el título dice "Fórmula ..." :cheerful:

sailepaty, falla en en años anteriores a 1900 y posteriores a 9999, pero avisa al generar #¡VALOR!

Por cierto, ¡"igualico" que Micro$oft Excel con las fechas! :greedy_dollars:

Sus límites son:

[TABLE=class: collapse]

[TR=class: trbgeven, bgcolor: #F3F3F3]

[TD]Primera fecha permitida en un cálculo[/TD]

[TD]1 de enero de 1900 (1 de enero de 1904, si se utiliza la fecha del sistema)[/TD]

[/TR]

[TR=class: trbgodd]

[TD]Última fecha permitida en un cálculo[/TD]

[TD]31 de diciembre de 9999[/TD]

[/TR]

[/TABLE]

[DBOX]Especificaciones y límites de Excel - Excel - Office.com[/DBOX]

Fleming, tu fórmula la he visto antes!!! (similar a la versión MacroAntoniana) :moon:

[DBOX]Method to determine whether a year is a leap year[/DBOX]

Tengo que recordar aquí (porque me viene muy a mano) el bug del año 1900, considerado erróneamente bisiesto por Excel:

[DBOX]Excel 2000 incorrectly assumes that the year 1900 is a leap year[/DBOX]

Gracias por vuestros comentarios y si sois buenos, al menos un día de este año bisiesto (que no es mucho pedir), os dejaré mi colección de fórmulas para calcular años bisiestos. :suspicion:

publicado
sailepaty, falla en en años anteriores a 1900 y posteriores a 9999, pero avisa al generar #¡VALOR!

Por cierto, ¡"igualico" que Micro$oft Excel con las fechas!

Sus límites son:

[TABLE=class: collapse]

[TR=class: trbgeven, bgcolor: #f3f3f3]

[TD]Primera fecha permitida en un cálculo

[/TD]

[TD]1 de enero de 1900 (1 de enero de 1904, si se utiliza la fecha del sistema)

[/TD]

[/TR]

[TR=class: trbgodd]

[TD]Última fecha permitida en un cálculo

[/TD]

[TD]31 de diciembre de 9999

[/TD]

[/TR]

[/TABLE]

1.-Me parece que el mes de febrero de 1900 esta dendro de esos limites, no?

2.-Quiere significar que por que Excel no calcula bien es correcto que tu formula no la haga?

Os dejaré mi colección de fórmulas para calcular años bisiestos.

Se te agradecerá enormemente, siempre listo para aprender algo nuevo. Ojala y sean mas originales que las que posteo Chandoo!!!

Saludos

publicado

Otra opción que me encontré en el baúl, pero desafortunadamente no recuerdo de donde la obtuve.

=SI(RESIDUO(A1;100);RESIDUO(A1;4);RESIDUO(A1;400))=0

Saludos

publicado

Hola de nuevo:

Esta función es tan pequeña, que parece una fórmula:

Public Function ESBISIESTO(Año As Range) As Boolean
[B]ESBISIESTO = Day((DateSerial(Año, 3, 1) - 1)) = 29[/B]
End Function
[/CODE]

Y aporta otro método distinto al que hemos empleado hasta ahora:

Preguntar si el día anterior al 1 de Marzo es 29. (*)

Besitos para todos.

[size=1]* (Sobre una idea de Adrian en TodoExcel)[/size]

publicado

Macro, ¿por qué no preguntas directamente si el 29 de febrero es un día del calendario?

Esta fórmula es la más corta que conozco:

Public Function EsAñoBisiesto(Año As Range) As Boolean
EsAñoBisiesto = IsDate("29/2/" & Año)
End Function[/CODE]

Esta función convertida en fórmula para calendarios en español y en inglés:

[CODE]=NO(ESERROR(FECHANUMERO("29/02/"&A1)))
=NOT(ISERROR(DATEVALUE("2/29/"&A1)))[/CODE]

Es un honor para mí compartir este foro con macronianos como tú. :o

publicado

sailepaty, está muy bien tener en cuenta en tu fórmula que el año 1900 no fue bisiesto.

[COLOR=#333333]=AÑO(("1/1/"&A1)+365+(A1=1900))=A1[/COLOR][/CODE]

Vamos a darle una vuelta de tuerca más a las fórmulas para calcular los años bisiestos. :sneakiness:

Para cualquier fórmula profesional se tiene que tener en cuenta el rango correcto de entradas para obtener la salida adecuada y esta vez ¡con la Iglesia hemos "topao"! :star:

[color=#000000][font=sans-serif]El 4 de octubre de 1582 fue el último día del calendario juliano y el 15 de octubre de 1582 fue el primer día del calendario gregoriano y ese año tuvo 10 días menos, siendo el primer año bisiesto de la historia, establecido por [/font][/color][color=#000000][font=sans-serif]el Papa Gregorio XIII en su bula [/font][/color][i]Inter gravisimas.

[DBOX]Año bisiesto - Wikipedia, la enciclopedia libre[/i][/DBOX]

Por lo tanto, cualquier año anterior a 1582 no puede ser bisiesto y habrá que tenerlo en cuenta en las fórmulas.

publicado

Definitivamente no dejemos que Don Gregorio nos arruine el calculo.

=(SI(RESIDUO(A1;100);RESIDUO(A1;4);RESIDUO(A1;400))+(A1<=1582))=0

[COLOR=#333333]=AÑO(("1/1/"&A1)+365+(A1=1900)+(A1<=1582))=A1[/COLOR]
[/CODE]

[color=#333333]Saludos[/color]

publicado

sailepaty, como comentaste que lees el foro de Chandoo, estoy posteando algunas de mis fórmulas en inglés.

[DBOX]Check if an year is leap year, using Excel Formulas | Chandoo.org - Learn Microsoft Excel Online[/DBOX]

En el foro de Chandoo llevamos publicadas 25 fórmulas para calcular los años bisiestos.

Es un honor que Rick Rothstein (MVP - Excel) haya replicado a alguna de mis sugerencias, siendo que escribe en uno de los blogs más famosos de Excel que os invito a leer si aún no lo conocéis:

[DBOX]Contextures Blog[/DBOX]

publicado

Pedro,

Felicidades por el honor que te causa la replica de Rick Rothstein. Sin embargo me parece que el blog al que haces referencia pertenece a Debra Dalgleish y Rick replica a los post que ella efectúa. Sin embargo y sin estar muy seguro creo haber leído algunos posts que el inicia con la autorización de Debra.

Y para no dejar de replicar y tal y como diría Rick. Similar a la formula de Pedro pero con una función menos.

[SIZE=2][FONT=arial] =ISNUMBER(1*(A1*(A1>1900)&"-02-29"))[/FONT][/SIZE]
[SIZE=2][FONT=arial]
=ESNUMERO(1*(A1*(A1>1900)&"-02-29"))
[/FONT][/SIZE][/CODE]

[size=2][font=arial]

Saludos[/font][/size]

publicado

sailepaty, gracias por la aclaración. Es lo que me pasa por leer demasiados blogs de Excel. Aunque sí, Rick escribe a menudo en el blog de Debra (autora de Contextures).

Ahora si que te ha quedado redonda. ¡Un diez maestro!

publicado

Las más cortas que he conseguido yo nunca han sido:

=DIA(1*("1/3/"&A1)-1)=29[/CODE]

que falla para 1900, y:

[CODE]=DIA(1*("1/3/"&A1)-1+(A1=1900))=29[/CODE]

que no falla para 1900.

Saludos.

Archivado

Este tema está ahora archivado y está cerrado a más respuestas.

  • 109 ¿Te parecen útiles los tips de las funciones? (ver tema completo)

    1. 1. ¿Te parecen útiles los tips de las funciones?


      • No
      • Ni me he fijado en ellos

  • Ayúdanos a mejorar la comunidad

    • Donaciones recibidas este mes: 0.00 EUR
      Objetivo: 130.00 EUR
  • Archivos

  • Estadísticas de descargas

    • Archivos
      188
    • Comentarios
      98
    • Revisiones
      29

    Más información sobre "Cambios en el Control Horario"
    Última descarga
    Por pegones1

    4    1

  • Crear macros Excel

  • Mensajes

    • Hola, veo que tienes 365, así que esta forma funcionará   Almacen.xlsx
    • Buenos días  @LeandroA espero estes bien Tengo un caso idéntico al planteado en la siguiente pregunta: Sin embargo, a diferencia de quien planteo originalmente la pregunta al correr el código no obtengo ningún resultado podrían ayudarme a resolver este inconveniente y que al hacer click en el Botón Guardar (CommandButton3) del Formulario RCS (frmrcs) el archivo pdf quede configurado con orientación vertical, márgenes superior, inferior, derecho e izquierdo = 1 y en página tamaño carta. Si acaso influye uso Microsoft Excel LTSC MSO (versión 2209 Compilación16.0.1.15629.20200) de 64 bits Mucho le sabre agradecer la ayuda que me pueda dar  RCS PRUEBA - copia.xlsm
    • @JSDJSDCon gusto mi estimado Para la opción 1: Sub Surtirhastadondealcanse() Dim ws As Worksheet Set ws = ThisWorkbook.Sheets(1) Dim filaInicio As Integer: filaInicio = 4 Dim filaFin As Integer: filaFin = 7 Dim colInventario As Integer: colInventario = 2 Dim colSolicitudesInicio As Integer: colSolicitudesInicio = 4 ' Columna C Dim colResultadoInicio As Integer: colResultadoInicio = 9 ' Columna I Dim colTotalSurtido As Integer: colTotalSurtido = 12 ' Columna L Dim colFinalInventario As Integer: colFinalInventario = 13 ' Columna M Dim numClientes As Integer: numClientes = 3 Dim fila As Integer, i As Integer For fila = filaInicio To filaFin Dim inventario As Double inventario = Val(ws.Cells(fila, colInventario).Value) Dim solicitudes(1 To 3) As Double Dim surtido(1 To 3) As Variant Dim totalSurtido As Double: totalSurtido = 0 ' Leer solicitudes For i = 1 To numClientes If IsNumeric(ws.Cells(fila, colSolicitudesInicio + i - 1).Value) Then solicitudes(i) = CDbl(ws.Cells(fila, colSolicitudesInicio + i - 1).Value) Else solicitudes(i) = 0 End If surtido(i) = "POR FALTA STOCK" Next i ' Surtir de acuerdo al inventario disponible For i = 1 To numClientes If solicitudes(i) > 0 Then If inventario >= solicitudes(i) Then surtido(i) = solicitudes(i) inventario = inventario - solicitudes(i) totalSurtido = totalSurtido + solicitudes(i) ElseIf inventario > 0 Then surtido(i) = inventario totalSurtido = totalSurtido + inventario inventario = 0 Else surtido(i) = "POR FALTA STOCK" End If End If Next i ' Escribir resultados en las columnas correspondientes para cada cliente For i = 1 To numClientes With ws.Cells(fila, colResultadoInicio + i - 1) If surtido(i) = "POR FALTA STOCK" Then .Value = surtido(i) .Font.Color = vbRed Else .Value = surtido(i) .Font.Color = vbBlack End If End With Next i ' Escribir total surtido y existencia final ws.Cells(fila, colTotalSurtido).Value = totalSurtido ws.Cells(fila, colFinalInventario).Value = inventario Next fila MsgBox "Resultado surtido cargado con éxito...", vbInformation End Sub Para la opción 2:   Sub surtirenpartesiguales() Dim ws As Worksheet Set ws = ThisWorkbook.Sheets(1) Dim filaInicio As Integer: filaInicio = 13 Dim filaFin As Integer: filaFin = 16 Dim colInventario As Integer: colInventario = 2 Dim colSolicitudesInicio As Integer: colSolicitudesInicio = 4 ' Columna C Dim colResultadoInicio As Integer: colResultadoInicio = 9 ' Columna I Dim colTotalSurtido As Integer: colTotalSurtido = 12 ' Columna L Dim colFinalInventario As Integer: colFinalInventario = 13 ' Columna M Dim numClientes As Integer: numClientes = 3 Dim fila As Integer, i As Integer For fila = filaInicio To filaFin Dim inventario As Double inventario = Val(ws.Cells(fila, colInventario).Value) Dim solicitudes(1 To 3) As Double Dim surtido(1 To 3) As Variant Dim totalSurtido As Double: totalSurtido = 0 Dim totalPedido As Double: totalPedido = 0 ' Leer solicitudes For i = 1 To numClientes If IsNumeric(ws.Cells(fila, colSolicitudesInicio + i - 1).Value) Then solicitudes(i) = CDbl(ws.Cells(fila, colSolicitudesInicio + i - 1).Value) totalPedido = totalPedido + solicitudes(i) Else solicitudes(i) = 0 End If surtido(i) = 0 Next i ' Si hay suficiente inventario, surtir lo que el cliente pide If inventario >= totalPedido Then For i = 1 To numClientes If solicitudes(i) > 0 And inventario >= solicitudes(i) Then surtido(i) = solicitudes(i) inventario = inventario - solicitudes(i) totalSurtido = totalSurtido + solicitudes(i) End If Next i Else ' Reparto base igualitario Dim baseSurtido As Long baseSurtido = Int(inventario / numClientes) For i = 1 To numClientes If solicitudes(i) > 0 Then If solicitudes(i) <= baseSurtido Then surtido(i) = solicitudes(i) inventario = inventario - solicitudes(i) totalSurtido = totalSurtido + solicitudes(i) Else surtido(i) = baseSurtido inventario = inventario - baseSurtido totalSurtido = totalSurtido + baseSurtido End If End If Next i ' Repartir sobrante restante uno por uno, respetando lo pedido Do While inventario > 0 For i = 1 To numClientes If surtido(i) < solicitudes(i) Then surtido(i) = surtido(i) + 1 totalSurtido = totalSurtido + 1 inventario = inventario - 1 If inventario = 0 Then Exit For End If Next i Loop End If ' Escribir resultados en las columnas correspondientes para cada cliente For i = 1 To numClientes With ws.Cells(fila, colResultadoInicio + i - 1) If surtido(i) = 0 Then .Value = "POR FALTA STOCK" .Font.Color = vbRed Else .Value = surtido(i) .Font.Color = vbBlack End If End With Next i ' Escribir total surtido y existencia final ws.Cells(fila, colTotalSurtido).Value = totalSurtido ws.Cells(fila, colFinalInventario).Value = inventario Next fila MsgBox "Resultado surtido cargado con éxito...", vbInformation End Sub Saludos, Diego
    • Buenos dias.  Estoy trabajando en una hoja para poder llevar un control de un pequeño almacén.  Tengo un pedido con varias líneas y "lotes" y necesito sacar las ubicaciones que coincidan con la referencia y lote que pone en el pedido. El problema viene cuando tengo la misma referencia y mismo lote en ubicaciones diferentes y necesito sacar la información en columnas diferentes. No se si  me he explicado bien, pero creo que con el ejemplo adjunto se entiende mejor. Agradecería mucho si me pudieran ayudar  Libro1.xlsx
    • Exelente solución mil gracias 
  • Visualizado recientemente

    • No hay usuarios registrado para ver esta página.
×
×
  • Crear nuevo...

Información importante

Echa un vistazo a nuestra política de cookies para ayudarte a tener una mejor experiencia de navegación. Puedes ajustar aquí la configuración. Pulsa el botón Aceptar, si estás de acuerdo.