Intervalos de fechas traslapadas en Excel con macros Vba (fórmula)

En casos específicos uno se encuentra con el problema de sumar rangos de fechas que se traslapan, cuando los rangos se cruzan o existen vacíos temporales es necesario aplicar operaciones especiales que es muy difícil lograr con fórmulas comunes. Por ejemplo cuando se toma en cuenta la experiencia profesional como requisito para postular a un trabajo es necesario evaluar al postulante y sumar correctamente la duración del tiempo laborado.

La siguiente fórmula ayudará a obtener la suma de rangos de fechas que se traslapan, pero es necesario observar que cuando se hacen este tipo de cálculos siempre pueden generarse errores, ya que los meses no tienen días uniformes. La fórmula evalúa la cantidad de días transcurridos desde 00/01/1900 hasta la suma de días teniendo en cuenta traslapes y vacíos, luego presenta el resultado final.

La fórmula considera las dos primeras columnas del rango a usar (nx2), la primera columna para la fecha inicial y la segunda para la fecha final. Se utiliza de la siguiente forma:

SUMARF([rango],[tipo(opcional)])

rango: Grupo de celdas que contienen la fecha inicial y final de cada elemento.
tipo: 1 -> Muestra la suma completa indicando años, meses y días
2 -> Muestra solamente años enteros
3 -> Muestra solamente meses enteros sin contar años
4 -> Muestra solamente días sin contar meses ni años
5 -> Muestra la cantidad de meses totales
6 -> Muestra la cantidad de días totales

fechastraslapadas

		
Function SUMARF(rango As Range, Optional tipo As Integer) As Variant

Application.Volatile

Dim matriz As Variant
Dim m_ini_1()
Dim m_fin_1()

matriz = rango
l = UBound(matriz, 1)

ReDim m_ini_1(l)
ReDim m_fin_1(l)

'separar matriz y convertir a valores numericos
For i = 1 To l
    m_ini_1(i) = CDbl(matriz(i, 1))
    m_fin_1(i) = CDbl(matriz(i, 2))
Next i

'ajustar traslape
m = 1
While m > 0
m = 0

For j = 1 To l
    For k = 1 To l
        If m_ini_1(k) < m_ini_1(j) And m_ini_1(j) < m_fin_1(k) Then
        m_ini_1(j) = m_ini_1(k)
        m = 1
        Exit For
        End If
        
        If m_ini_1(k) < m_fin_1(j) And m_fin_1(j) < m_fin_1(k) Then
        m_fin_1(j) = m_fin_1(k)
        m = 1
        Exit For
        End If
    Next k
Next j

Wend

'sumar los que no se duplican
tot = 0
For p = 1 To l
    juntar = m_fin_1(p) & m_ini_1(p)
    For q = 1 To l
        If juntar = m_fin_1(q) & m_ini_1(q) And p = q Then
            tot = tot + (m_fin_1(p) - m_ini_1(p))
        ElseIf juntar = m_fin_1(q) & m_ini_1(q) And p <> q Then
            Exit For
        End If
    Next q
Next p

' resultado
anios = Application.Evaluate("=DATEDIF(0," & tot & ",""y"")")
mes = Application.Evaluate("=DATEDIF(0," & tot & ",""ym"")")
mesu = Application.Evaluate("=DATEDIF(0," & tot & ",""m"")")
dias = Application.Evaluate("=DATEDIF(0," & tot & ",""md"")")
diasu = Application.Evaluate("=DATEDIF(0," & tot & ",""d"")")

If anios <> 1 Then
t_a = " años "
Else
t_a = " año "
End If

If mes <> 1 Then
t_m = " meses "
Else
t_m = " mes "
End If

If dias <> 1 Then
t_d = " días"
Else
t_d = " dia"
End If

Select Case tipo

Case 1
totfinal = anios & t_a & mes & t_m & dias & t_d
Case 2
totfinal = anios
Case 3
totfinal = mes
Case 4
totfinal = dias
Case 5
totfinal = mesu
Case 6
totfinal = diasu
Case Else
totfinal = anios & t_a & mes & t_m & dias & t_d
End Select

SUMARF = totfinal

End Function

Dejo el ejemplo para descargar gratuitamente esperando observaciones y comentarios para poder mejorar la fórmula.

Etiquetas:, , , ,

"Trackback" Enlace desde tu web.

M. Vizcarra

Ing. Industrial, egresado de la Facultad de Ingeniería Industrial y de Sistemas de la Universidad Nacional Hermilio Valdizán de Huánuco, Perú.

Comentarios (3)

  • Fredysa

    |

    Excelente trabajo, solo tengo una observación. Si se utiliza para calcular la experiencia de una persona en un cargo que trabajo por ejemplo del 1 de nov de 2015 al 30 de nov de 2015, su experiencia es de 30 días, (se incluyen los extremos); no obstante si se digitàn las dos fechas y se hace el calculo, la macro arroja un resultado de 29 días, es decir se esta perdiendo un día de experiencia; a veces determinante ya que al restar los y traslapos, cada día tiene importancia. Se que se soluciona sumando 1 en una formulación normal, pero no se como incorporarlo en la macro. ¿ Podrías Hacer este ajuste, por favor?

    Gracias

    Reply

  • Fredysa

    |

    ahh, se me olvido en el comentario anterior, también trate de insertar filas y las acepta pero el resultado no varia, se puede ampliar las tareas a mas de ocho? …como?

    Reply

  • Zarela Araceli

    |

    Por favor tengo la misma duda del usuario Fredysa, cómo lograr que cuente el número de días totales.

    Excelente trabajo, solo tengo una observación. Si se utiliza para calcular la experiencia de una persona en un cargo que trabajo por ejemplo del 1 de nov de 2015 al 30 de nov de 2015, su experiencia es de 30 días, (se incluyen los extremos); no obstante si se digitàn las dos fechas y se hace el calculo, la macro arroja un resultado de 29 días, es decir se esta perdiendo un día de experiencia; a veces determinante ya que al restar los y traslapos, cada día tiene importancia. Se que se soluciona sumando 1 en una formulación normal, pero no se como incorporarlo en la macro. ¿ Podrías Hacer este ajuste, por favor?

    Reply

Deja un comentario