Remplissage auto m'oublie le dernier élément

12sans-donnees.xlsm (134.12 Ko)

Bonjour,

J'ai crée un remplissage automatique qui fonctionne presque comme je veux.

J’avais demandé a ce que lors du remplissage automatique :

Si le dernier aller était compris entre la variable dateDepart et dateRetour et que la date de retour était en dehors de cette plage alors il ne mécrit pas la ligne correspondante. Cela fonctionne

Autre condition :

Si lors du remplissage, la date de retour de mon vol tombe le même jour que la variable dateRetour alors il prend cette valeur en compte.

Le souci est qu'il ne me le prend pas en compte alors qu’il devrait me le prendre. Il s'arrête a la ligne d'avant si jamais la date de retour de mon vol = la variable dateRetour.

Le deuxième souci est qu’il faut ajouter une règle :

Lors du remplissage automatique, seuls les vols ayant une date d’aller inférieure ou égale à la date inscrite dans la cellule J1 sont autorisé.

Si la date de retour est après la date inscrite en J1 cela ne pose pas de problème tant que la date d’aller est bien avant la date en J1 et que le retour n’excède pas 14 jours suivant la date de J1.

je joins mon code et le fichier avec le code en copie.

Sub RemplirFormulaire()

    ' Variables pour les données de la plage de dates
    Dim dateDepart As Date
    Dim intervalleOUT As Integer
    Dim dateRetour As Date
    Dim intervalleIN As Integer
    Dim dureeCircuit As Integer

    ' Variables pour les données du vol OUTBOUND
    Dim departOUT As Date
    Dim volOUT As String
    Dim cityairOUT As String
    Dim placesOUT As Integer

    ' Variables pour les données du vol INBOUND
    Dim departIN As Date
    Dim volIN As String
    Dim cityairIN As String
    Dim placesIN As Integer

    ' Variables pour la boucle
    Dim ligne As Integer

    ' Trouver la dernière ligne remplie
    ligne = Cells(Rows.Count, 3).End(xlUp).Row + 1

    ' Définir les valeurs des variables à partir des cellules spécifiées
    dateDepart = Range("G4").Value
    intervalleOUT = Range("H4").Value
    dateRetour = Range("I4").Value
    intervalleIN = Range("J4").Value
    dureeCircuit = Range("K7").Value

    ' Boucle pour remplir le formulaire en fonction des critères
    Do While departOUT <= dateRetour
        ' Remplir les données pour le vol OUTBOUND
        departOUT = dateDepart
        volOUT = Range("F6").Value
        cityairOUT = Range("B6").Value & Range("C6").Value
        placesOUT = Range("I6").Value

        ' Remplir les données pour le vol INBOUND
        departIN = departOUT + dureeCircuit
        volIN = Range("F7").Value
        cityairIN = Range("B7").Value & Range("C7").Value
        placesIN = Range("I7").Value

        ' Vérifier que le retour ne dépasse pas la date en I4
        If departIN <= dateRetour Then
            ' Vérifier que le retour est dans la plage de dates
            If departIN + intervalleIN <= dateRetour Then
                ' Écrire les données dans les cellules appropriées
                Cells(ligne, 3).Value = departOUT
                Cells(ligne, 5).Value = volOUT
                Cells(ligne, 7).Value = cityairOUT
                Cells(ligne, 8).Value = placesOUT
                Cells(ligne, 9).Value = departIN
                Cells(ligne, 11).Value = volIN
                Cells(ligne, 13).Value = cityairIN
                Cells(ligne, 14).Value = placesIN

                ' Mettre en gras et changer la couleur des cellules dans les colonnes C, E, G, H
                With Cells(ligne, 3).Resize(, 1).Resize(, 4).Font
                    .Bold = True
                    .Color = RGB(0, 32, 91) ' Couleur #00205B
                End With

                ' Mettre en gras et changer la couleur des cellules dans les colonnes I, K, M, N
                With Cells(ligne, 9).Resize(, 1).Resize(, 4).Font
                    .Bold = True
                    .Color = RGB(192, 0, 0) ' Couleur #C00000
                End With

                ' Mettre en gras et changer la couleur des cellules dans les colonnes GH
                With Cells(ligne, 7).Resize(, 1).Resize(, 2).Font
                    .Bold = True
                    .Color = RGB(0, 32, 91) ' Couleur #00205B
                End With

                ' Mettre en gras et changer la couleur des cellules dans les colonnes M, N
                With Cells(ligne, 13).Resize(, 1).Resize(, 2).Font
                .Bold = True
                .Color = RGB(192, 0, 0) ' Couleur #C00000
                End With

                ' Passer à la ligne suivante
                ligne = ligne + 1
            End If
        Else
            Exit Do ' Si le retour dépasse la date en I4, sortir de la boucle
        End If

        ' Mettre à jour la date de départ pour le prochain vol OUTBOUND
        dateDepart = dateDepart + 7 - (WorksheetFunction.Weekday(dateDepart, 2) - intervalleOUT) Mod 7
    Loop

End Sub

N'hésitez pas si vous ne comprenez pas quelque chose. je suis bloqué depuis un petit moment dessus et ne sait pas vers qui me tourner.

Merci d'avance !

bonsoir,

pour ton 1er problème

cette instruction est celle qui fait que tu n'as pas l'info qui est affichée

  If departIN + intervalleIN <= dateRetour Then

si date de départ est le 16/12/2023 et le retour est 18/12/2023

departOUT= 16/12/2023

duree circuit = 2

departIN = departOUT + dureeCircuit => departIN=18/12/2023

IntervalleIN = 2 ' résultat de JOURSEM(I4;1) ????????? vérifier si cette formule est correcte.

quand la macro arrive sur l'instruction que j'ai mise en évidence ci-dessus le test

si 18/12/2023+2 jours <=18/12/2023 'condition qui n'est pas vraie on n'effectue pas les écritures sur la feuille

Hello h2so4,

je viens de voir ton message. je me suis penché sur ce que tu mas dis et j'ai apporté quelques modifs. Conclusion : ca fonctionne parfaitement. Merci beaucoup !!!

Rechercher des sujets similaires à "remplissage auto oublie dernier element"