Développer des dates

Sub Traitement()
Dim PlageResult As Range
Dim TabTemp As Variant, Result As Variant
Dim L As Long, L2 As Long, D As Long
      With Sheets('Feuil1')
            'Charge les données dans un tableau variant temporaire
            L = .Range('A65536').End(xlUp).Row
            TabTemp = .Range(.Cells(6, 1), .Cells(L, 2)).Value
            'Détermine la longueur maxi du tableau résultats (Nbre de lignes)
            For L = 1 To UBound(TabTemp, 1)
                  D = D + DateDiff('d', TabTemp(L, 1), TabTemp(L, 2))
            Next L
            'Dimensionnement du tableau résultats
            ReDim Result(1 To L + D, 1 To 2)
            'Transfert des données dans le tableau résultats
            For L = 1 To UBound(TabTemp, 1)
                  L2 = L2 + 1
                  Result(L2, 1) = TabTemp(L, 1)
                  'si Debut/Fin chevauchent 2 dates
                  D = DateDiff('d', TabTemp(L, 1), TabTemp(L, 2))
                  If D > 0 Then
                        'On comble l'espace temps entre les 2 dates
                        Result(L2, 2) = DateValue(Result(L2, 1)) + TimeValue('23:59')
                        Do While Result(L2, 2) < TabTemp(L, 2)
                              Result(L2 + 1, 1) = DateValue(Result(L2, 1)) + 1 _
                                          + TimeValue('00:00')
                              L2 = L2 + 1
                              Result(L2, 2) = DateValue(Result(L2, 1)) + TimeValue('23:59')
                        Loop
                  End If
                  Result(L2, 2) = TabTemp(L, 2)
            Next L
            'Définition de la plage des résultats sur la feuille
            Set PlageResult = .Range(.Cells(6, 4), Cells(5 + UBound(Result, 1), 3 + _
                        UBound(Result, 2)))
      End With
      'MAJ de la feuille
      PlageResult.Value = Result
      PlageResult.NumberFormat = 'dd/mm/yyyy hh:mm'
End Sub

Cliquez pour agrandir...