IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

automatisation des dates et copie des cellules suivant condition [XL-2007]


Sujet :

Macros et VBA Excel

Vue hybride

Message précédent Message précédent   Message suivant Message suivant
  1. #1
    Futur Membre du Club
    Homme Profil pro
    Étudiant
    Inscrit en
    Juillet 2015
    Messages
    4
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Deux Sèvres (Poitou Charente)

    Informations professionnelles :
    Activité : Étudiant

    Informations forums :
    Inscription : Juillet 2015
    Messages : 4
    Par défaut automatisation des dates et copie des cellules suivant condition
    Bonjour à tous,

    je vous explique mon petit problème, ça fait 4 jours que je parcours les différents forums afin de trouver des réponses à mes questions, mais cela sans résultat^^.

    Donc dans le cadre de mon stage, je dois refaire un tableur excel afin de faire un suivi de réunion hebdomadaire.

    Cependant, le tableur excel qu'il y avait précédemment, ne correspondait plus aux attentes des utilisateurs, c est pourquoi j'en ai refait un. Mais je souhaite désormais automatiser quelques procédures au nombre de 3 :
    (je sais pas si je dois créer plusieurs sujets ou non)

    1) automatiser le remplissage de la colonne A au prochain mardi ouvré
    2) recopier l'ensemble des cellules De A à G dans une seconde feuille lorsque qu'une condition est remplie ( Etat = En cours)
    3) sur cette 2e feuille ajouter en colonne H une date automatique à J+20 ouvrés

    Alors je sais pas si c'est possible, mais je l'espère, je suis prêt à juste avoir quelques pistes afin d'essayer de trouver par moi-même la solution (qui a parlé de méthode du tâtonnement, car oui, je débute juste en VBA)


    D'avance je vous remercie et je vous joins le fichier excel )test2.xlsm


    EDIT : si en cellule A je mets cette fonction
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    =SI(ESTVIDE(C11);"";SI((C11)<>"";AUJOURDHUI()-JOURSEM(AUJOURDHUI())+10))
    Cela me permet il réellement de prévoir le mardi suivant?

  2. #2
    Membre Expert
    Homme Profil pro
    Chef de projet en SSII
    Inscrit en
    Novembre 2011
    Messages
    1 503
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Irlande

    Informations professionnelles :
    Activité : Chef de projet en SSII

    Informations forums :
    Inscription : Novembre 2011
    Messages : 1 503
    Par défaut
    Bonjour proufixe,

    Tout d'abord, pour ceci :
    Citation Envoyé par proufixe Voir le message
    1) automatiser le remplissage de la colonne A au prochain mardi ouvré
    voici ce que je te propose :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    Option Explicit
     
    Sub remplir_ColA()
    Dim oRng As Range
    Dim nb_sem As Integer
    Dim i As Integer
    Dim oDate As Date
    Dim oBool As Boolean
    Dim oFerie As Range
    Dim oStart As Integer
     
    With Worksheets("UPCAPO")
        Set oRng = .Cells(Rows.Count, 1).End(xlUp)
        On Error GoTo MauvaisType
        nb_sem = CInt(InputBox("Nombre de semaines à remplir :", "Remplissage de la colonne A", 10))
     
        If nb_sem > 0 Then
            If oRng.Row = 6 Then
                oDate = Date
                oStart = 2
            Else
                If IsDate(oRng) Then
                    oDate = CDate(oRng)
                    oStart = 0
                Else
                    MsgBox "La dernière valeur de la colonne A n'est pas une date."
                    Exit Sub
                End If
            End If
     
            For i = oStart + 1 To oStart + nb_sem
                oBool = False
                Do Until oBool
                    oDate = MardiProchain(oDate)
                    Set oFerie = Range("Jours_fériés").Find(oDate, LookIn:=xlValues, LookAt:=xlWhole)
                    If oFerie Is Nothing Then
                        oBool = True
                    End If
     
                    Set oFerie = Nothing
                Loop
                oRng.Offset(i, 0) = oDate
            Next i
        End If
        Exit Sub
    End With
     
     
    MauvaisType:
    MsgBox "La valeur saisie doit être numérique.", vbCritical
     
    End Sub
     
    Public Function MardiProchain(oDate As Date) As Date
     
    If Weekday(oDate, vbMonday) = 1 Then
        MardiProchain = oDate + (2 - Weekday(oDate, vbMonday))
    Else
        MardiProchain = oDate + (7 - Weekday(oDate, vbMonday)) + 2
    End If
     
    End Function
    En colonne A tu auras tous les Mardi non-fériés selon le nombre de semaines d'entré.
    Attention :
    1. Tu dois supprimer toutes les formules dans ta colonne A.
    2. Tu dois avoir une plage nommée que j'ai appelé "Jours_fériés".


    Ensuite, pour le reste :
    Citation Envoyé par proufixe Voir le message
    2) recopier l'ensemble des cellules De A à G dans une seconde feuille lorsque qu'une condition est remplie ( Etat = En cours)
    3) sur cette 2e feuille ajouter en colonne H une date automatique à J+20 ouvrés
    voici ce que je te propose :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    Sub recopier()
    Dim oRng As Range
    Dim i As Long
    Dim nb_action As Long
    Dim oDest As Range
     
    With Worksheets("UPCAPO")
        nb_action = .Cells(Rows.Count, 7).End(xlUp).Row
        Set oRng = .Cells(nb_action, 7).End(xlUp)
        For i = 0 To nb_action - oRng.Row + 1
            If oRng.Offset(i, 0) = "En cours" Then
                With Worksheets("Feuil1")
                    Set oDest = .Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
                    oDest.Resize(1, 7).Value = Range(oRng.Offset(i, -6), oRng.Offset(i, 0)).Value
                    oDest.Offset(0, 7) = WorksheetFunction.WorkDay(Date, 20, Range("Jours_fériés"))
                End With
            End If
        Next i
     
    End With
     
    End Sub
    J'utilise également la même plage pour les jours fériés.

    Je te renvoie ton classeur en pièce jointe : test2.xlsm
    J'ai fait quelques tests, ça me semble ok.

    N'hésite pas à revenir vers moi !

    Cordialement,
    Kimy

  3. #3
    Futur Membre du Club
    Homme Profil pro
    Étudiant
    Inscrit en
    Juillet 2015
    Messages
    4
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Deux Sèvres (Poitou Charente)

    Informations professionnelles :
    Activité : Étudiant

    Informations forums :
    Inscription : Juillet 2015
    Messages : 4
    Par défaut
    Houa, je n'en demandais pas tant, merci bien


    Je regarde ça et je ne manquerais pas de revenir vers toi je le pense au moins pour que je puisse comprendre

    la logique ( car il parait que c'est logique le VBA excel)

    Merci bien en tout cas

  4. #4
    Rédacteur
    Avatar de Philippe Tulliez
    Homme Profil pro
    Formateur, développeur et consultant Excel, Access, Word et VBA
    Inscrit en
    Janvier 2010
    Messages
    13 176
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Belgique

    Informations professionnelles :
    Activité : Formateur, développeur et consultant Excel, Access, Word et VBA

    Informations forums :
    Inscription : Janvier 2010
    Messages : 13 176
    Billets dans le blog
    53
    Par défaut
    Bonjour,
    Pour les questions
    1) automatiser le remplissage de la colonne A au prochain mardi ouvré
    Une autre solution sans VBA.
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    =DateJour-JOURSEM(DateJour-2)+8
    Le 2 en rouge est la constante pour mardi (2ème jour de la semaine) et dateJour représente la date du jour ou tout autre date d'ailleurs, la formule calculant le mardi qui suit cette date.

    2) recopier l'ensemble des cellules De A à G dans une seconde feuille lorsque qu'une condition est remplie ( Etat = En cours)
    Tu pourrais utiliser le filtre avancé d'excel manuellement ou par VBA. A lire Les filtres avancés ou élaborés dans Excel

    3) sur cette 2e feuille ajouter en colonne H une date automatique à J+20 ouvrés
    La formule NB.JOURS.OUVRES effectue ce genre de calcul.
    Philippe Tulliez
    Ce que l'on conçoit bien s'énonce clairement, et les mots pour le dire arrivent aisément. (Nicolas Boileau)
    Lorsque vous avez la réponse à votre question, n'oubliez pas de cliquer sur et si celle-ci est pertinente pensez à voter
    Mes tutoriels : Utilisation de l'assistant « Insertion de fonction », Les filtres avancés ou élaborés dans Excel
    Mon dernier billet : Utilisation de la fonction Dir en VBA pour vérifier l'existence d'un fichier

  5. #5
    Membre Expert
    Homme Profil pro
    Chef de projet en SSII
    Inscrit en
    Novembre 2011
    Messages
    1 503
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Irlande

    Informations professionnelles :
    Activité : Chef de projet en SSII

    Informations forums :
    Inscription : Novembre 2011
    Messages : 1 503
    Par défaut
    Avec les explications :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    Option Explicit
     
    'Procédure qui permet de remplir la colonne A en fonction de son formalisme.
    'Utilise la fonction "MardiProchain" qui renvoi le prochain Mardi par rapport à la date placée en paramètre.
    'Permet ainsi de remplir la colonne A avec le prochain Mardi ouvré.
    Sub remplir_ColA()
    'Déclaration des variables
    Dim oRng As Range
    Dim nb_sem As Integer
    Dim i As Integer
    Dim oDate As Date
    Dim oBool As Boolean
    Dim oFerie As Range
    Dim oStart As Integer
     
    'Avec la feuille "UPCAPO"
    With Worksheets("UPCAPO")
        'On set "oRng" sur la première cellule non vide de la colonne A
        Set oRng = .Cells(Rows.Count, 1).End(xlUp)
     
        'Affiche une InputBox permettant de définir le nombre de semaines que l'on souhaite remplir
        'Si la valeur insérée n'est pas numérique => gère l'erreur et sort de la procédure
        On Error GoTo MauvaisType
        nb_sem = CInt(InputBox("Nombre de semaines à remplir :", "Remplissage de la colonne A", 10))
     
        'Si le nombre de semaine insérée est suppérieure à 0
        If nb_sem > 0 Then
            'On vérifie la ligne atteinte par oRng
            If oRng.Row = 6 Then
                'Si cette valeur est 6 (ce qui représente la cellule fusionnée "Précédents points APO disponibles sous : V/Outils/APO/archive :..."
                'Alors cela signfie qu'aucune valeur n'est présente en colonne A
                'On set alors oDate à la date du jour
                oDate = Date
                'Et oStart à 2 (permettant de définir l'offet et de placer la première valeur en A10
                oStart = 2
            Else
                'Si oRng est différent de 6, on a donc des valeurs dans la colonne A
                'On vérifie que la dernière valeur est bien une date
                If IsDate(oRng) Then
                    'Si c'est une date, on la prend comme référence et on la plce dans oDate
                    oDate = CDate(oRng)
                    'Et on n'aura donc pas d'offset
                    oStart = 0
                Else
                    'Si la valeur n'est pas une date, on affiche un message d'erreur et on sort de la procédure.
                    MsgBox "La dernière valeur de la colonne A n'est pas une date."
                    Exit Sub
                End If
            End If
     
            'On boucle de i = oStart + 1 à oStrat + nb_sem
            For i = oStart + 1 To oStart + nb_sem
                'On set oBool à False
                oBool = False
                'Et on boucle tant que oBool n'est pas à True
                Do Until oBool
                    'Va dans la fonction "MardiProchain" avec le paramètre oDate.
                    'Et on écrase oDate avec la valeur que retourne la fonction.
                    'Celle-ci permet de définir le prochain Mardi par rapport à la date placée en paramètre.
                    oDate = MardiProchain(oDate)
                    'On cherche sur les valeurs "Jours_fériés" si on trouve la date renvoyée par la fonction "MardiProchain"
                    Set oFerie = Range("Jours_fériés").Find(oDate, LookIn:=xlValues, LookAt:=xlWhole)
                    'Si on ne trouve rien, cela signifie que le prochain Mardi n'est pas férié
                    If oFerie Is Nothing Then
                        'On passe donc oBool à True pour sortir de la boucle.
                        'On pourrait aussi mettre "Exit Do". Ceci éviterait de déclarer la variable oBool. Pas pensé avant ^^
                        oBool = True
                    End If
     
                    'Et si jamais on a trouvé une valeur pour le Mardi prochain férié, il faut mettre oFerie à Nothing
                    Set oFerie = Nothing
                Loop
     
                'Dès que l'on sort de la boucle, cela signifie que le prochain Mardi trouvé n'est pas férié.
                'Ainsi on place cette valeur dans oRng avec un décalage de i lignes.
                oRng.Offset(i, 0) = oDate
            Next i
        End If
        Exit Sub
    End With
     
     
    MauvaisType:
    MsgBox "La valeur saisie doit être numérique.", vbCritical
     
    End Sub
     
    'Fontion qui retourne le prochain Mardi par rapport à la date placée en paramètre.
    Public Function MardiProchain(oDate As Date) As Date
     
    If Weekday(oDate, vbMonday) = 1 Then
        MardiProchain = oDate + (2 - Weekday(oDate, vbMonday))
    Else
        MardiProchain = oDate + (7 - Weekday(oDate, vbMonday)) + 2
    End If
     
    End Function
     
    'Fonction qui recopie toutes les lignes qui ont un statut "En cours"
    'Recopie les colonnes A à G de la feuille "UPCAPO" => sur les colonnes A à G de la feuille "Feuil1"
    Sub recopier()
    'Déclaration des variables
    Dim oRng As Range
    Dim i As Long
    Dim nb_action As Long
    Dim oDest As Range
     
    'Avec la feuille "UPCAPO"
    With Worksheets("UPCAPO")
        'On définie nb_action comme étant le numéro de la dernière ligne non-vide de la colonne G
        nb_action = .Cells(Rows.Count, 7).End(xlUp).Row
        'On définie oRng comme étant la première ligne non-vide de la colonne G
        '/!\ ici, il est considéré qu'il n'y a pas d'action avec un statut nul. Toutes les actions doivent donc avec un statut en colonne G
        Set oRng = .Cells(nb_action, 7).End(xlUp)
     
        'On boucle de i = 0 au nombre d'actions que l'on trouve en colonne G (en respectant le point d'attention ci-dessus).
        For i = 0 To nb_action - oRng.Row + 1
            'Si la valeur de la ligne (colonne G) est "En cours" alors...
            If oRng.Offset(i, 0) = "En cours" Then
                '... avec la feuille "Feuil1"...
                With Worksheets("Feuil1")
                    '... on set oDest comme étant la cellule de dessous de la dernière cellule non-vide (de la colonne A)
                    Set oDest = .Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
                    'Et on place sur les colonnes A à G de la feuille "Feuil1" les valeurs A à G de la feuille "UPCAPO"
                    oDest.Resize(1, 7).Value = Range(oRng.Offset(i, -6), oRng.Offset(i, 0)).Value
                    'On place en colonne H la date du jour + 20 jours ouvrés.
                    oDest.Offset(0, 7) = WorksheetFunction.WorkDay(Date, 20, Range("Jours_fériés"))
                End With
            End If
        Next i
     
    End With
     
    End Sub
    Cordialement,
    Kimy

  6. #6
    Futur Membre du Club
    Homme Profil pro
    Étudiant
    Inscrit en
    Juillet 2015
    Messages
    4
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Deux Sèvres (Poitou Charente)

    Informations professionnelles :
    Activité : Étudiant

    Informations forums :
    Inscription : Juillet 2015
    Messages : 4
    Par défaut
    Hello hello,

    tout cela me va parfaitement, avec les deux méthodes j'arrive parfaitement à avoir ce que je souhaite.

    C est a dire, a avoir la date auto lors d une saisie en C et ce sans limiter le nombre de saisie à une cellule.

    De plus, ça me permet de supprimer la feuillde "aide" avec les jours fériés, puisque le tableur orignal, est un tableur qui est partagé avec 4 services.

    Enfin, je me suis permis d'enlever la référence au jours féries dans cette ligne
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
      oDest.Offset(0, 7) = WorksheetFunction.WorkDay(Date, 20)
    Pour les même raisons qu au dessus.

    voici la maccro finale,
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    Private Sub CommandButton1_Click()
    'Fonction qui recopie toutes les lignes qui ont un statut "En cours"
    'Recopie les colonnes A à G de la feuille "UPCAPO" => sur les colonnes A à G de la feuille "Feuil1"
    Dim oRng As Range
    Dim i As Long
    Dim nb_action As Long
    Dim oDest As Range
     
    'Avec la feuille "UPCAPO"
    With Worksheets("UPCAPO")
        'On définie nb_action comme étant le numéro de la dernière ligne non-vide de la colonne G
        nb_action = .Cells(Rows.Count, 7).End(xlUp).Row
        'On définie oRng comme étant la première ligne non-vide de la colonne G
        '/!\ ici, il est considéré qu'il n'y a pas d'action avec un statut nul. Toutes les actions doivent donc avec un statut en colonne G
        Set oRng = .Cells(nb_action, 7).End(xlUp)
     
        'On boucle de i = 0 au nombre d'actions que l'on trouve en colonne G (en respectant le point d'attention ci-dessus).
        For i = 0 To nb_action - oRng.Row + 1
            'Si la valeur de la ligne (colonne G) est "En cours" alors...
            If oRng.Offset(i, 0) = "En cours" Then
                '... avec la feuille "Feuil1"...
                With Worksheets("Feuil1")
                    '... on set oDest comme étant la cellule de dessous de la dernière cellule non-vide (de la colonne A)
                    Set oDest = .Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
                    'Et on place sur les colonnes A à G de la feuille "Feuil1" les valeurs A à G de la feuille "UPCAPO"
                    oDest.Resize(1, 7).Value = Range(oRng.Offset(i, -6), oRng.Offset(i, 0)).Value
                    'On place en colonne H la date du jour + 20 jours ouvrés.
                    oDest.Offset(0, 7) = WorksheetFunction.WorkDay(Date, 20)
                End With
            End If
        Next i
     
    End With
     
    End Sub
    test2arecopier.xlsm
    En tout cas, un grand merci à vous


    EDIT : Bon j'ai un petit souci, c est a dire, que ca recopie l ensemble des cellule avec le statut en cours, sans supprimer les doublons

  7. #7
    Futur Membre du Club
    Homme Profil pro
    Étudiant
    Inscrit en
    Juillet 2015
    Messages
    4
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Deux Sèvres (Poitou Charente)

    Informations professionnelles :
    Activité : Étudiant

    Informations forums :
    Inscription : Juillet 2015
    Messages : 4
    Par défaut
    Bon j'ai remédié à la copie des doublons en faisant une deuxième macro qui supprime les doublons,

    Cependant dans lorsque la macro recopié s'exécute, elle marque les données en colonnes H ( soit J+20) pas au format date, ce qui fait que quand j exécute la macro "effacé" il reste quelques doublons puisque H n'est pas au format date



    Bon en écrivant, je me suis rendu compte que je suis un andouille, car il suffit que je ne prenne pas en compte la colonne H.


    Bon par contre, j'ai toujours le même problème puisque mes nouvelles données sont écrites dans une police a caractère 10. Une idée?

    (je laisse le sujet en résolu, car ce n'est pas non plus primordial)

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. [XL-2010] Validation des données et copie de cellule
    Par stueur666 dans le forum Excel
    Réponses: 19
    Dernier message: 23/01/2018, 14h06
  2. Copy des dates des dossiers
    Par alpha_one_x86 dans le forum C
    Réponses: 1
    Dernier message: 01/04/2013, 15h54
  3. selection des dates du moins courant ou suivant
    Par gtraxx dans le forum Langage SQL
    Réponses: 2
    Dernier message: 01/04/2009, 14h12
  4. [Dates] Problème avec des dates et Heures
    Par snakejl dans le forum Langage
    Réponses: 9
    Dernier message: 16/05/2006, 18h04
  5. Réponses: 3
    Dernier message: 27/01/2006, 12h36

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo