¿ Como sumar fechas para obtener resultado exacto?

[Loren]

compañeros:

Tengo una fecha de partida (dFechaActual) y un get donde el usuario teclea un nº de meses. (Nmeses)

Con estos 2 datos tengo que sumar y obtener la fecha final. Esto es facil pero no exacto:

dFechaFinal=(Nmesesx30 )+dFechaActual ---> como NO todos los meses tienen 30 días, el resultado final es aprox. pero no exacto.

¿ Como se calcularía el exacto ?

Mil gracias.
LORENZO

[Manuel Valdenebro]

Utilizo para eso dos funciones:

1) Una adaptación de la antigua Nanforum (da problemas en Febrero)

2) Una función propia que intenta solucionar el tema de Febrero.

Te icluyo las dos para que la adaptes a tus necesidades:

/*
* File......: MADD.PRG
* Author....: Jo W. French dba Practical Computing
* Nanforum Toolkit
* Añade meses a una fecha
* dFecha la fecha inicial
* nMeses numero de meses
*/

FUNCTION ADI_MES( dFecha, nMeses )
LOCAL nAdjDay, dTemp, i

// si dFecha no es tipo fecha
IF(VALTYPE(dFecha) != 'D', dFecha := DATE(), )

// si nMeses no es tipo numérico
IF(VALTYPE(nMeses) != 'N', nMeses := 0, )

nAdjDay := DAY( dFecha ) - 1 // dia del mes menos uno

dTemp := dFecha - nAdjDay // primero de mes

/* Work with 1st of months.*/
FOR i := 1 TO ABS(nMeses)
dTemp += IF( nMeses > 0, 31, -1 )
dTemp += 1 - DAY( dTemp )
NEXT

dTemp := MIN( (dTemp + nAdjday), (dTemp += 31 - DAY( dTemp + 31 )))
RETURN dTemp

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

//////////////////////////////////////////////////
/// M.Valdenebro 2006
/// Añade meses a una fecha
/// lSuma suma / .f. resta el mes
/////////////////////////////////////////////////

FUNCTION ADI_CSB ( dFecha, nMeses, nFinMes, nFinFeb, lSuma )
LOCAL nAdjDay, dTemp, i
DEFAULT lSuma := .t.

// si dFecha no es tipo fecha
IF(VALTYPE(dFecha) != 'D', dFecha := DATE(), )
// si nMeses no es tipo numérico
IF(VALTYPE(nFinMes) != 'N', nFinMes := 0, )

nAdjDay := DAY( dFecha ) - 1 // numero de dias menos UNO

dTemp := dFecha - nAdjDay // primero de mes

FOR i := 1 TO ABS(nMeses)
IF lSuma
dTemp += 31 // se va a una fecha del mes siguiente
dTemp += 1 - DAY( dTemp )
ELSE
dTemp -= 31 // se va a una fecha del mes siguiente
dTemp -= 1 - DAY( dTemp )
ENDI
NEXT
dTemp := MIN( (dTemp + nAdjday), (dTemp += 31 - DAY( dTemp + 31 )))
IF MONTH ( dFecha ) = 2 // si es febrero
IF DAY ( dFecha ) > 27 // si el dia es superior al dia 27
IF MONTH (dTemp) = 2 // si el nuevo mes es febrero
dTemp := EOM( dTemp)
ELSE // si el nuevo mes no es febrero
IF nFinFeb = 0 // Si era dia 31 en un mes 31
dTemp := EOM( dTemp)
ELSE
dTemp := EOM( dTemp) - nFinFeb
ENDI
ENDI
ENDI
ELSE
// meses de 31 dias
IF MONTH (dFecha) = 3 .or. MONTH (dFecha) = 5 .or. ;
MONTH (dFecha) = 7 .or. MONTH (dFecha) = 8 .or. ;
MONTH (dFecha) = 10 .or. MONTH (dFecha) = 12
IF DAY ( dFecha ) = 31
dTemp := EOM( dTemp)
ENDI
// meses de 30 dias
ELSEIF MONTH ( dFecha ) <> 1 // no es Enero
IF DAY ( dFecha ) = 30
IF nFinMes = 0 // Si era dia 31 en un mes 31
dTemp := EOM( dTemp)
ENDI
ENDI
ENDI
ENDI
RETURN dTemp

[Loren]

Mil gracias...

lo adaptaré a mis necesiddades.

Un saludo.

[dobfivewin]

Hola estimado

Otra funcion para que veas, No es exatamente lo que necesitas pero puede ayudar


Saludos

Code: Select all  Expand view  RUN

* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* F U N C I O N: Tiempo(<fFechaIni> [, <fFechaFin>] [, <nRegresa>] [, cSeparador]) -> cTiempo
* DESCRIPCION  : Investiga los Años, Meses y Días transcurridos desde la fecha <fFechaIni> y la fecha <fFechaFin>
* PARAMETROS   : <fFechaIni> -> Primera fecha a tratar.
*                <fFechaFin> -> Segunda Fecha a tratar. Si se omite este parámetro, se tomará la fecha actual con DATE().
*                <nRegresa>  -> Indica que tipo de dato se está solicitando:
*                               1 = Años
*                               2 = Años y Meses
*                               3 = Años, Meses y Días
*                <cSeparador> -> Caracter a utilizar como separador entre los Años, Meses y Días. Por default será: '.'
* R E G R E S A: <cTiempo> -> Cadena de caracteres con los Años, Meses y Días transcurridos
*                             desde la fecha <fFechaIni> hasta la fecha <fFechaFin>
* E J E M P L O: ? Tiempo( CTOD('17/07/1971'), CTOD('06/07/2001'), 1) ) -> '29'     // Años
*                ? Tiempo( CTOD('23/03/1972'), CTOD('06/07/2001'), 2) ) -> '29.3'   // Años.Meses
*                ? Tiempo( CTOD('03/04/1960'), CTOD('06/07/2001'), 3) ) -> '41.3.3' // Años.Meses.Días
*
FUNCTION Tiempo(fFechaIni, fFechaFin, nRegresa, cSeparador)
  LOCAL cAnos, cMese, cDias, cTiempo
  LOCAL nAnos, nMese, nDias, nDiaUltimo, fAux , aa,mm

  DEFAULT fFechaFin := DATE()
  DEFAULT nRegresa  := 1
  DEFAULT cSeparador:= '.'

  If EMPTY(fFechaIni)
     RETURN('')
  EndIf

  nDias := fFechaFin - fFechaIni

  // AÑOS...
  nAnos := INT(nDias / 365)

  // MESES...
  fAux   := CTOD( STR(DAY(fFechaIni)) + '/' + STR(MONTH(fFechaIni)) + '/' + STR(YEAR(fFechaFin) - 1,4))
  nMese := INT((fFechaFin - fAux) / 30.42)
  nMese := IF(nMese >= 12, nMese - 12, nMese)

  // DIAS...
  mm := If(MONTH(fFechaFin) - 1 < 1 , 12 , MONTH(fFechaFin) - 1 )
  aa := If(MONTH(fFechaFin) - 1 < 1 , YEAR(fFechaFin)-1 , YEAR(fFechaFin) )

  fAux  := CTOD( STR(DAY(fFechaIni)) + '/' + ;                  // Dia de Fecha DESDE
                 STRzero(mm,2) + '/' + ;        // Mes de Fecha HASTA - 1
                 STR(aa, 4))                                // Año de Fecha HASTA

*  fAux  := CTOD( STR(DAY(fFechaIni)) + '/' + ;                 // Dia de Fecha DESDE
*                 STR(MONTH(fFechaFin) - 1) + '/' + ;       // Mes de Fecha HASTA - 1
*                 STR(YEAR(fFechaFin), 4))                              // Año de Fecha HASTA

  nDias := fFechaFin - fAux                                                         // Fecha HASTA -
  nDiaUltimo := DAY( DiaUltimo(fAux) )
  nDias :=  IF(nDias >= nDiaUltimo, nDias - nDiaUltimo, nDias)

  cAnos := if( nAnos>0 , alltrim( STR(nAnos) )+ ' años' , '')
  cMese := if( nMese>0 , alltrim( STR(nMese) )+ ' mes'+if(nMese>1,'es','') , '')
  cDias := if( nDias>0 , alltrim( STR(nDias) )+ ' dia'+if(nDias>1,'s','') , '')

  DO CASE
    CASE nRegresa = 1
      cTiempo := cAnos
    CASE nRegresa = 2
      cTiempo := cAnos + If(nAnos>0,cSeparador,'') + cMese
    CASE nRegresa = 3
      cTiempo := cAnos + If(nAnos>0,cSeparador,'') +;
                 cMese + If(nMese>0,cSeparador,'') + cDias
  ENDCASE

RETURN(cTiempo)
*
* FIN Tiempo()
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *


* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* FUNCION    : DiaUltimo( <fFecha> ) -> fFecha.
* DESCRIPCION: Sirve para averiguar el dia ultimo del mes de una fecha cualquiera.
* PARAMETROS : <fFecha>. Es la fecha que se va a tratar. Por defecto, es la fecha
*              del sistema.
* REGRESA    : <fFecha>. Es la fecha que corresponde al dia ultimo del mes de la
*              fecha mandada como parámetro.
*
FUNCTION DiaUltimo(fFecha)
LOCAL fFechaAux         // Fecha con el día primero del mes mandado en fFecha.
LOCAL nMes, nAno

  If VALTYPE(fFecha) <> 'D'
     fFecha := DATE()
  EndIf

  // Se calcula el día primero del mes siguiente de la fecha pasada.
  nMes := IF(MONTH(fFecha) = 12, 1, MONTH(fFecha) + 1)
  nAno := YEAR(fFecha) + IF(nMes = 1, 1, 0)

  fFechaAux := CTOD('01/' + alltrim( STR(nMes) ) + '/' +;
               alltrim( STR(nAno) ))

RETURN fFechaAux-1     // Al dia primero del mes siguiente se le resta un dia.
*
* FIN DiaUltimo()
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

[jcenteno]

Loren,

Esto debe ser lo que buscas:

AddMonth( <dDate>, <nMonths> ) --> dNewDate

Arguments:
<dDate>
A Date value, except for an empty date, can be passed.
<nMonths>
An integer numeric value specifying the number of months to add to <dDate>. If <nMonths> is a negative value, it is subtracted from <dDate>. Return
The function returns the modified date, or an empty date on error.

Saludos,

Jairo

[Manuel Valdenebro]

Loren,

Esto debe ser lo que buscas:

AddMonth( <dDate>, <nMonths> ) --> dNewDate

Esto no funciona siempre. Si tu tienes un cliente al que le adeudas un recibo los dias 30 de cada mes, cuando llegue el mes de Febrero lo adeudará el dia 28 de Febrero y a partir de esta fecha, siempre lo adeudara los dias 28 de cada mes, no los dias 30. Igual ocurre si el contrato comienza el dia 31 de Enero (vencimiento dia ultimo de cada mes), cuando pase Febrero, ya cambiara y los siguientes vencimientos los pondrá el dia 28 ó 29, dependiendo si Febrero es bisiesto.

[jesusdelamora]

FALTO

SET DATE BRIT

[jesusdelamora]

FALTO

SET DATE BRIT

[FranciscoA]

Hola, dale un vistazo. Puede ser que ahi encuentres lo que necesitas.
viewtopic.php?f=6&t=16715&hilit=funcion+pago+de+excel&sid=1756c2ae36dacad374668ad3e57da8bb#p86705
Saludos.

[Armando]

Amigos:

Hasta donde entiendo lo que Loren expone debiera ser algo parecido a esto

Fecha Inicial: 30/01/2016
Mese a aumentar: 2

Entonces

30/01/2016 + 29 días del mes de febrero + 31 días del mes de marzo
la nueva fecha sería 29/03/2016

Lorenzo, entendí bien lo que necesitas?

Saludos

[Armando]

Lorenzo:

Si mi apreciación es correcta esta función puede serte de ayuda.

Code: Select all  Expand view  RUN

STATIC FUNCTION CalFec()
   LOCAL dFecIni  := CTOD("28/12/2016")
   LOCAL dFecFin  := dFecIni
   LOCAL nMeses   := 2
   LOCAL nVez     := 0
   LOCAL nAmo     := 0
   LOCAL nDias      := 0

    nMes                := MONTH(dFecIni)
   nAmo           := YEAR(dFecIni)

   FOR nVez := 1 TO nMeses
    nMes++

    IF nMes > 12
        nAmo++
        nMes := 1
    ENDIF

        nDias += DAYSINMONTH(MONTH(CTOD("01/" + STRZERO(nMes,2,0) + "/" + STRZERO(nAmo,4,0))))
   NEXT

    dFecFin := dFecIni + nDias

    MsgInfo(nDias)
    MsgInfo(dFecFin)
RETURN(NIL)
 

La hice al vuelo y en obvio de tiempo utilizo constantes para no hacer un dialogo.

Saludos

[horacio]

Armando, la rutina funciona siempre y cuando no calculemos años bisiestos ya que la función DAYSINMONTH no lo tiene en cuenta. Saludos

[Armando]

Horacio, Lorenzo y amigos del foro:

Tienes la boca llena de razón, pero el bien siempre debe triunfar sobre el mal,
basta con agregar unas líneas para determinar si el mes a agregar es Febrero
de un año bisiesto.

La rutina quedaría así, probadla y viertan sus resultados.

Code: Select all  Expand view  RUN

STATIC FUNCTION CalFec()
   LOCAL dFecIni  := CTOD("15/01/2016")
   LOCAL dFecFin  := dFecIni
   LOCAL nMeses   := 1
   LOCAL nVez     := 0
   LOCAL nAmo     := 0
   LOCAL nDias      := 0

    nMes                := MONTH(dFecIni)
   nAmo           := YEAR(dFecIni)

   FOR nVez := 1 TO nMeses
    nMes++

    IF nMes > 12
        nAmo++
        nMes := 1
    ENDIF

        nDias += DAYSINMONTH(MONTH(CTOD("01/" + STRZERO(nMes,2,0) + "/" + STRZERO(nAmo,4,0))))

        // Determinamos si el mes es FEBRERO de un año BISIESTO, Incrementamos los días
        IF nMes == 2
            IF MOD(nAmo,400) == 0
                nDias++
            ELSE
                IF MOD(nAmo,4) == 0
                    IF MOD(nAmo,100) > 0
                        nDias++
                    ENDIF
                ENDIF
            ENDIF
        ENDIF
   NEXT

    dFecFin := dFecIni + nDias

    MsgInfo(nDias)
    MsgInfo(dFecFin)
RETURN(NIL)
 

Seguramente el código se puede simplificar, sobre todo en los IFs, pero por
claridad y fácil entendimiento los escribí así.

Saludos

[Armando]

Amigos del foro:

Ya entrado en gastos , aquí dejo esta pequeña función
para determinar si el año es bisiesto.

Lorenzo, Horacio, con esta función podemos sustituir los IFs, del ejemplo
incluido en mi post anterior.

Code: Select all  Expand view  RUN

/*
    IsLeap      :   Función para determinar si el año es bisiesto (.T.)
                        o no (.F.)
    Recibe      :   El año a determinar
    Parámetros :   nAmo = El año a determinar si es bisiesto o no
    Devuelve        :   (.T.) en caso se ser bisiesto o (.F.) en caso contrario
    Fecha           :   11/Jul/2004
    Autor           :   Armando Estrada Bucio
    Compañia       :   SOI, s.a. de c.v.
        Copyright           : El código es libre solo pido no remover estas líneas
*/
FUNCTION IsLeap(nAmo)
RETURN( ((nAmo % 4) == 0 .AND.;
    (nAmo % 100) <> 0) .OR.;
    ((nAmo % 400) == 0) )

Espero les sea de utilidad.

Saludos

[horacio]

Muchas gracias Armando, funciona perfectamente. El bien a triunfado sobre el mal una vez mas ...

Saludos