XL 2013 Afficher date arrivé sous condiotion

chaelie2015

XLDnaute Accro
Bonjour FORUM;
ci dessous un code; voici ces étapes: :

1. Le code commence par définir des variables pour référencer les feuilles de travail nécessaires et stocker les valeurs pertinentes.
2. Il récupère la date de départ, le nombre et les dates de début et de fin à partir de la feuille "Motif".
3. Il vérifie d'abord si la date de départ est dans l'intervalle spécifié (entre la date de début et la date de fin) et si le nombre est supérieur à zéro.
4. S'il satisfait à ces conditions, le code initialise un compteur à zéro.
5. Il commence ensuite à parcourir les cellules de la colonne AS de la feuille "CRT" (de AS17 à AS47).
6. À chaque itération, il vérifie si la cellule AS est vide. Si la cellule est vide, il passe à la cellule suivante. Si la cellule AS n'est pas vide, il incrémente le compteur.
7. Il continue de parcourir les cellules de la colonne AS jusqu'à ce que le compteur atteigne la valeur spécifiée dans la cellule O3 de la feuille "Motif".
8. Une fois que le compteur atteint la valeur spécifiée, le code enregistre la date correspondante de la cellule AS dans la variable `DerniereDate` et sort de la boucle.
9. Enfin, le code affiche la valeur de `DerniereDate` dans la cellule T3 de la feuille "Motif".

j'ai exécuté toutes ces étapes mais, ça n'a pas fonctionné ?


VB:
Sub CalculerDateArrivee()
    Dim wsMotif As Worksheet
    Dim wsCRT As Worksheet
    Dim DateDepart As Date
    Dim Nombre As Integer
    Dim DateDebut As Date
    Dim DateFin As Date
    Dim Compteur As Integer
    Dim DerniereDate As Variant
    
    ' Référence à la feuille "Motif"
    Set wsMotif = ThisWorkbook.Sheets("Motif")
    
    ' Référence à la feuille "CRT"
    Set wsCRT = ThisWorkbook.Sheets("CRT")
    
    ' Récupération des valeurs depuis la feuille "Motif"
    DateDepart = wsMotif.Range("R3").Value
    Nombre = wsMotif.Range("O3").Value
    DateDebut = wsMotif.Range("R2").Value
    DateFin = wsMotif.Range("T2").Value
    
    ' Vérification des conditions
    If DateDepart >= DateDebut And DateDepart <= DateFin And Nombre > 0 Then
        ' Comptage des cellules non vides dans la colonne AS de la feuille "CRT"
        Compteur = 0
        For Compteur = 17 To 47 ' Plage AS17:AS47
            If wsCRT.Cells(Compteur, "AS").Value <> "" Then
                Nombre = Nombre - 1
                If Nombre = 0 Then
                    DerniereDate = wsCRT.Cells(Compteur, "AS").Value
                    Exit For
                End If
            End If
        Next Compteur
    End If
    
    ' Affichage du résultat dans la cellule T3 de la feuille "Motif"
    wsMotif.Range("T3").Value = DerniereDate
End Sub

Merci par avance
 

Pièces jointes

  • CHARLIE date arruvée sous condition.xlsm
    18.8 KB · Affichages: 9
Solution
VB:
Sub CalculerDateArrivee()
    Dim wsMotif As Worksheet
    Dim wsCRT As Worksheet
    Dim DateDepart As Date
    Dim Nombre As Integer
    Dim DateDebut As Date
    Dim DateFin As Date
    Dim Compteur As Integer
    Dim DerniereDate As Variant
    
    ' Référence à la feuille "Motif"
    Set wsMotif = ThisWorkbook.Sheets("Motif")
    
    ' Référence à la feuille "CRT"
    Set wsCRT = ThisWorkbook.Sheets("CRT")
    
    ' Récupération des valeurs depuis la feuille "Motif"
    With wsMotif
        DateDepart = .Range("R3").Value
        Nombre = .Range("O3").Value
        DateDebut = .Range("R2").Value
        DateFin = .Range("T2").Value
    End With
    
    If DateDepart < DateDebut Or DateDepart > DateFin Then
        MsgBox "la...

chaelie2015

XLDnaute Accro
Bonjour chalie2015, [Edit] vgendron,

J'ai rarement vu un code aussi tarabiscoté !!!

Chez moi la date 01/04/2023 s'affiche en Motif!T3.

Et c'est normal puisqu'il y a le code Nombre = Nombre - 1 => on sort de la boucle à la 1ère itération.

A+
Bonjour JOB
Ce sont des erreurs dues à la copie et au collage, généralement commises sans une grande attention.
Aussi,je te remercie pour la solution que tu as suggérée dans la discussion de l'infobulle.
Bien que ce soit en retard, c'est toujours mieux que rien. 😜
 

Discussions similaires

Statistiques des forums

Discussions
314 723
Messages
2 112 197
Membres
111 462
dernier inscrit
ymd76