Répartition et somme entre deux date dans un calendrier

[LPM]

Bonjour à tous,

Tout d'abord je vous remercie pour votre aide et le temps que vous nous offrez.

J'ai beau me creuser les méninges, et avec mes faibles connaissances en excel je ne trouve pas de solution. Pire encore, je n'ai pas réussi à trouver de solution correspondant à mon problème sur pas mal de forum.

Je vous explique.

J'extrais tous les jours de mon logiciel hotelier un fichier csv qui me liste toutes mes réservations.Cela fonctionne par date. Exemple, une réservation pour une arrivée au 01/01, départ au 03/01, pour une chambre double.

J'aimerais synthétiser ce fichier sur un calendrier qui m'indiquerait le nombre de chambre vendu (par catégorie) et par date.

A savoir que plus j'avance dans le temps, plus la liste des réservations s'allongent. Donc la formule nécessaire ne doit pas s'arrêter uniquement aux dernières valeurs / lignes du tableau.

Dans le premier onglet du fichier que j'ai joint, se trouver la liste des réservations. Et j'aimerais voir la synthèse dans mon deuxième onglet.

Je vous remercie par avance pour votre retour.

 

[klin89]

Re : Répartition et somme entre deux date dans un calendrier

Re,

Restitution verticale du tableau :

Option Explicit

Sub Compter_Reservations()
Dim a, i As Long, j As Long, nbrejours As Long, AL As Object
Dim myMin As Date, myMax As Date, k As Date
    Set AL = CreateObject("System.Collections.ArrayList")
    With Sheets(1).Range("a3").CurrentRegion
        a = .Value
        myMin = CDate(Application.Min(.Columns(1)))
        myMax = CDate(Application.Max(.Columns(2)))
    End With
    For k = myMin To myMax
        AL.Add k
    Next
    With CreateObject("Scripting.Dictionary")
        For i = 2 To UBound(a, 1)
            nbrejours = a(i, 2) - a(i, 1)
            If Not .exists(a(i, 4)) Then
                Set .Item(a(i, 4)) = _
                CreateObject("Scripting.Dictionary")
                .Item(a(i, 4)).CompareMode = 1
            End If
            For j = 0 To nbrejours - 1
                .Item(a(i, 4))(a(i, 1) + j) = .Item(a(i, 4))(a(i, 1) + j) + 1
            Next
        Next
        AL.Sort
        ReDim a(1 To AL.Count + 1, 1 To .Count + 1)
        a(1, 1) = ""
        For i = 0 To AL.Count - 1
            a(i + 2, 1) = AL(i)
        Next
        For i = 0 To .Count - 1
            a(1, i + 2) = .keys()(i)
            For j = 0 To .items()(i).Count - 1
                a(AL.IndexOf(.items()(i).keys()(j), 0) + 2, i + 2) = .items()(i).items()(j)
            Next
        Next
    End With
    Application.ScreenUpdating = False
    'Restitution verticale
    With Sheets("Feuil2")
        .Cells.Clear
        With .Cells(1).Resize(UBound(a, 1), UBound(a, 2))
            '.FormulaLocal = a
            .Value = a
            .Font.Name = "calibri"
            .Font.Size = 10
            .VerticalAlignment = xlCenter
            .BorderAround Weight:=xlThin
            .Borders(xlInsideVertical).Weight = xlThin
            With .Rows(1)
                .BorderAround Weight:=xlThin
                With .Offset(, 1).Resize(, .Columns.Count - 1)
                    .HorizontalAlignment = xlCenter
                    .Interior.ColorIndex = 36
                End With
            End With
            With .Columns(1)
                With .Offset(1).Resize(.Rows.Count - 1)
                    .HorizontalAlignment = xlCenter
                    .Interior.ColorIndex = 38
                End With
            End With
            .Columns("a:d").ColumnWidth = Array(13, 11, 11, 11)
        End With
        .Activate
    End With
    Application.ScreenUpdating = True
End Sub

klin89