Ayuda!!! suma de dias de un rango de fechas que se traslapan o no

[fjchavez]

Hola mrocf,
Publico la funcion que he creado para este calculo por si alguien más se topa con esta tarea.

Funcion OrdenarMatrizNx2: Coje el rango y ordena segun fechas y lo almacena en una matriz Nx2
Funcion TDiasTraslapan: Calcula la suma total de dias (sin repetición) cuando hay fechas que se traslapan.

Código VBA:

Function OrdenarMatrizNx2(r As Range) As Variant
 
Dim ArrayName As Variant
Dim t As Variant
Dim i As Integer
Dim j As Integer
Dim y As Integer
Dim condition1 As Boolean
Dim condition2 As Boolean
Dim sortcolumn1 As Integer
Dim sortcolumn2 As Integer
 
ArrayName = r
sortcolumn1 = 1
sortcolumn2 = 2
 
For i = LBound(ArrayName, 1) To UBound(ArrayName, 1) - 1
    For j = LBound(ArrayName, 1) To UBound(ArrayName, 1) - 1
        condition1 = (ArrayName(j, sortcolumn1) > ArrayName(j + 1, sortcolumn1))
        condition2 = ((ArrayName(j, sortcolumn1) = ArrayName(j + 1, sortcolumn1)) And (ArrayName(j, sortcolumn2) > ArrayName(j + 1, sortcolumn2)))
        If condition1 Or condition2 Then
            For y = LBound(ArrayName, 2) To UBound(ArrayName, 2)
                 t = ArrayName(j, y)
                 ArrayName(j, y) = ArrayName(j + 1, y)
                 ArrayName(j + 1, y) = t
            Next y
        End If
    Next j
Next i
 
OrdenarMatrizNx2 = ArrayName
 
End Function
 
Function TDiasTraslapan(r As Range) As Integer
 
Dim a, b, d As Integer
Dim ArrayName As Variant
ReDim ArrayFechas(1 To 2, 1 To 1) As Variant
Dim dias As Long
 
Application.Volatile
 
'Trasladamos a matriz y ordenamos los datos con la funcion OrdenaMatrizNx2
ArrayName = OrdenarMatrizNx2(r)
'Asignamos la primera columna con los valores fecha inicial y fecha final de ArrayName
ArrayFechas(1, 1) = ArrayName(1, 1)
ArrayFechas(2, 1) = ArrayName(1, 2)
'Procedemos a comparar y rellenar la matriz ArrayFechas
For a = LBound(ArrayName, 1) + 1 To UBound(ArrayName, 1)
    b = LBound(ArrayName, 2)
    fila = UBound(ArrayFechas, 1)
    columna = UBound(ArrayFechas, 2)
    Select Case ArrayName(a, b) <= ArrayFechas(fila, columna)
        Case True
            If ArrayName(a, b + 1) > ArrayFechas(fila, columna) Then
                ArrayFechas(fila, columna) = ArrayName(a, b + 1)
            End If
        Case False
            ReDim Preserve ArrayFechas(1 To 2, 1 To columna + 1)
            ArrayFechas(fila - 1, columna + 1) = ArrayName(a, b)
            ArrayFechas(fila, columna + 1) = ArrayName(a, b + 1)
    End Select
Next a
        
ArrayFechas = Application.Transpose(ArrayFechas)
dias = 0
 
For d = LBound(ArrayFechas, 1) To UBound(ArrayFechas, 1)
dias = dias + CDate(ArrayFechas(d, UBound(ArrayFechas, 2))) - CDate(ArrayFechas(d, LBound(ArrayFechas, 2))) + 1
Next d
 
TDiasTraslapan = dias
 
End Function
 

Gracias por la ayuda mrocf