Calendrier de transport simple

Bonjour,

Je travail sur un calendrier des transports tout simple, il n'y a qu'un seul camion donc juste un calendrier à la semaine.

J'ai pour changer de semaine un Spinbutton, mais j'aimerais garder les informations en mémoire, que se soit pour les semaines précédentes ou futur. Ainsi en changeant de semaine nous sommes capable de voir les transports déjà effectués ou à effectuer.

Je bloque sur la boucle qui ne fonctionne pas comme je le souhaite... Je vous joint le fichier.

Merci

Kilian

EDIT: Ah bah je pense que c'est ta feuille BD , je vais regarder ce que je peux faire

Hello,

Si tu veux garder en mémoire, le plus simple je pense c'est d'avoir une feuille d'historisation.

Tu la masques comme tu as fait pour NPA.

Tu veux que je te propose qqch ?

Voila

Hello,

Merci pour ta réponse et ta solution.

Je vois que tu as mis que quand la date ne correspond pas, une ligne s'enregistre avec "Aucun enregistrement ce jour", donc si nous passons d'une semaine à l'autre, la feuille BD va s'alimenter de ce commentaire inutilement.

J'imagine quand supprimant la ligne

Union(BD.Range("B" & Last_L_BD), BD.Range("C" & Last_L_BD), BD.Range("D" & Last_L_BD)) = " AUCUN ENREGISTREMENT CE JOUR"

Nous n'aurons juste plus d'enregistrement ?

Egalement ta boucle prend toutes les cellules entre chaque enregistrement, donc si je n'ai qu'un transport à 17h00, toute la journée sera enregistré, je penses qu'a terme ceci va ralentir le fichier, car pour charger le calendrier chaque semaine des informations qui sont dans BD je devrait faire une boucle sur toute la feuille BD.

Est-ce qu'un simple IF pour vérifier la présence d'un NPA ferais l'affaire ?

Merci,

Kilian

Hello,

Oui tout à fait :

Sub Memo()
Dim BD, PL As Worksheet
Dim j&, Col_Date&, Last_L_BD&, i&
Dim Heure As Date, NPA As String, Objet As String

Set BD = Sheets("BD")
Set PL = Sheets("Planning_V2")

With PL
    Col_Date = 2
    For j = 1 To 5
        Last_L_BD = BD.Cells(Rows.Count, 1).End(xlUp).Row + 1
        Select Case .Cells(Rows.Count, Col_Date).End(xlUp).Row
            Case Is = 2
'                BD.Range("A" & Last_L_BD) = .Cells(1, Col_Date)
'                Union(BD.Range("B" & Last_L_BD), BD.Range("C" & Last_L_BD), BD.Range("D" & Last_L_BD)) = " AUCUN ENREGISTREMENT CE JOUR"
            Case Else
                For i = 3 To .Cells(Rows.Count, Col_Date).End(xlUp).Row
                    If .Cells(i, Col_Date) <> "" Then
                        Heure = .Cells(i, 1)
                        NPA = .Cells(i, Col_Date)
                        Objet = .Cells(i, Col_Date + 2)
                        BD.Range("A" & Last_L_BD) = .Cells(1, Col_Date)
                        BD.Range("B" & Last_L_BD) = Heure
                        BD.Range("C" & Last_L_BD) = NPA
                        BD.Range("D" & Last_L_BD) = Objet
                        Last_L_BD = BD.Cells(Rows.Count, 1).End(xlUp).Row + 1
                    End If
                Next i
        End Select
        Col_Date = Col_Date + 3
    Next j
End With
MsgBox " Memo ok"

Hello,

Top merci ça fonctionne très bien.

Il me reste tout de même un soucis, et c'est la que je bloque surtout.. Il faudrait contrôler si la date et l'heure sont déjà présent dans BD avant de faire l'enregistrement afin de ne pas avoir des lignes à double.

J'avais fait quelques tentative, mais ma boucle devrait regarder pour chaque date+Heure si ça correspond dans BD, et elle passe à la ligne suivante sans passé à travers toutes la feuille BD.

J'espère que mes explications ne sont pas trop brouillon.. Peux-tu me donner la synthaxe correct à adapté dans les boucles ?

Merci,

Kilian

Hello,

Tu peux tester pour moi ? (à mettre dans le même module)

Sub Memo()
Dim BD As Worksheet, PL As Worksheet
Dim j&, Col_Date&, Last_L_BD&, i&
Dim Heure As Date, NPA As String, Objet As String
Dim Tab_Verif

Set BD = Sheets("BD")
Set PL = Sheets("Planning_V2")

With PL
    Col_Date = 2
    For j = 1 To 5
        Last_L_BD = BD.Cells(Rows.Count, 1).End(xlUp).Row + 1
        Select Case .Cells(Rows.Count, Col_Date).End(xlUp).Row
            Case Is = 2
                Resume Next
            Case Else
                Tab_Verif = BD.Range("A1").CurrentRegion
                For i = 3 To .Cells(Rows.Count, Col_Date).End(xlUp).Row
                    If .Cells(i, Col_Date) <> "" _
                        And Not Est_Present(.Cells(1, Col_Date), .Cells(i, 1), Tab_Verif) = True Then
                            Heure = .Cells(i, 1)
                            NPA = .Cells(i, Col_Date)
                            Objet = .Cells(i, Col_Date + 2)
                            BD.Range("A" & Last_L_BD) = .Cells(1, Col_Date)
                            BD.Range("B" & Last_L_BD) = Heure
                            BD.Range("C" & Last_L_BD) = NPA
                            BD.Range("D" & Last_L_BD) = Objet
                            Last_L_BD = BD.Cells(Rows.Count, 1).End(xlUp).Row + 1
                    End If
                Next i
        End Select
        Col_Date = Col_Date + 3
    Next j
End With
MsgBox " Memo ok"

End Sub

Function Est_Present(Verif_Date As Date, Verif_heure As Date, Tab_Verif As Variant) As Boolean

Dim i&

Est_Present = False
For i = LBound(Tab_Verif, 1) To UBound(Tab_Verif, 1)
    If Tab_Verif(i, 1) = Verif_Date _
        And Tab_Verif(i, 2) = Verif_heure Then
            Est_Present = True
            Exit For
    End If
Next i

End Function

Hello,

Tester et ça marche très bien !

Merci beaucoup pour tes réponses

A bientôt,

Kilian