automatisation des dates et copie des cellules suivant condition

**proufixe** · 09/07/2015, 10h05

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?

**Kimy_Ire** · 09/07/2015, 14h34

Bonjour proufixe,

Tout d'abord, pour ceci :

Envoyé par proufixe

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 :

Tu dois supprimer toutes les formules dans ta colonne A.
Tu dois avoir une plage nommée que j'ai appelé "Jours_fériés".

Ensuite, pour le reste :

Envoyé par proufixe

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

**proufixe** · 09/07/2015, 14h46

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

**Philippe Tulliez** · 09/07/2015, 16h13

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.

**Kimy_Ire** · 09/07/2015, 16h26

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

**proufixe** · 10/07/2015, 09h46

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

**proufixe** · 10/07/2015, 13h16

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)

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

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager