A propos des dates

[colaplsus]

Bonjour bonjour, me revoici avec un nouveau probleme sur les bras,
Imaginer, je possede différentes dates :
mercredi 1 juin 2011
jeudi 2 juin 2011
vendredi 3 juin 2011
lundi 6 juin 2011
mardi 7 juin 2011
mercredi 8 juin 2011
jeudi 9 juin 2011
vendredi 10 juin 2011
lundi 13 juin 2011
mardi 14 juin 2011
mercredi 15 juin 2011
jeudi 16 juin 2011
vendredi 17 juin 2011
lundi 20 juin 2011

et je voudrais grace a une macro ajouter les dates manquantes jusqu'a la fin du mois, et aussi prendre en compte le fait qu'il soit possible qu'une date manque dans les données présentes, tels qu'un mercredi entre mardi et jeudi.

J'ai ce code pour m'aider

Sub jour()
Dim i As Integer
Dim R As Integer
Dim x As Integer
x = 1
While x < 5
Sheets("4158").Select
i = 12
For i = 12 To Range("A" & Rows.Count).End(xlUp).Row
While Weekday(Cells(i, 1)) <= 5 And Day(Cells(i, 1)) <= 31
If i = Range("A" & Rows.Count).End(xlUp).Row Then Exit Sub
If Weekday(Cells(i + 1, 1)) - Weekday(Cells(i, 1)) <> 1 And Cells(i, 1) <> 0 Then
Rows(i + 1).Insert Shift:=xlDown
Cells(i + 1, 1).Value = (Cells(i, 1)) + 1
i = i + 1
Else
i = i + 1
End If
Wend
Next
x = x + 1
Wend

End Sub
en effet, il ne me faut que les 5 jours de la semaine, le code fonctionne bien, mais s'arrete si il constate qu'il n'y a pas de lundi apres un vendredi.

Quelqu'un aurait une idée ?

 

[Gorfael]

Re : A propos des dates

Salut colaplsus et le forum
Une idée :
Les dates correspondent au nombre de jours depuis le 1 janvier 1900. 40724 => 30 Juin 2011
Il suffit donc de faire une boucle soit décrémentante, soit incrémentatnte qui teste si la ligne d'avant (d'après) est égale à la valeur de la cellule -1 (+1) et si on est dans un jour de semaine (de mardi à vendredi ou de lundi à jeudi) et +3 pour le WE.

Pas envie de chercher plus loin, ne comprenant pas la boucle de X
A+

 

[colaplsus]

Re : A propos des dates

Autant pour moi, j'avais la boucle de X pour ne la tester que sur une semaine, mais opurrais tu mieux m'expliquer, car la je peche un peu ^^

 

[bond]

Re : A propos des dates

Cette version du code à tester :

Sub jour()
Dim i As Integer, R As Integer, x As Integer
x = 1
While x < 5
Sheets("4158").Select
i = 12
For i = 12 To Range("A" & Rows.Count).End(xlUp).Row
    While Weekday(Cells(i, 1)) <= 6 And Day(Cells(i, 1)) <= 31
        If i = Range("A" & Rows.Count).End(xlUp).Row Then Exit Sub
            If Weekday(Cells(i + 1, 1)) - Weekday(Cells(i, 1)) <> 1 And Cells(i, 1) <> 0 Then
                Rows(i + 1).Insert Shift:=xlDown
                Cells(i + 1, 1).Value = Cells(i, 1) + IIf(Weekday(Cells(i, 1)) = 6, 3, 1)
                i = i + 1
            Else
                i = i + 1
        End If
        Wend
    Next
    x = x + 1
Wend
End Sub

 

[colaplsus]

Re : A propos des dates

Tu m'a fait créer une boucle

 

[bond]

Re : A propos des dates

là, ça s'arrête

Sub jour()
Dim i As Integer, Endi As Long
Sheets("4158").Select
Endi = Range("A" & Rows.Count).End(xlUp).Row
For i = 12 To Endi
    While Weekday(Cells(i, 1)) <= 6 And Day(Cells(i, 1)) <= 31
        If i = Range("A" & Rows.Count).End(xlUp).Row Then Exit Sub
        If Weekday(Cells(i + 1, 1)) - Weekday(Cells(i, 1)) <> 1 And Cells(i, 1) <> 0 Then
            Rows(i + 1).Insert Shift:=xlDown
            Cells(i + 1, 1).Value = Cells(i, 1) + IIf(Weekday(Cells(i, 1)) = 6, 3, 1)
            Endi = Endi + 1
            i = i + 1
        End If
        i = i + 1
    Wend
Next
End Sub

 

[colaplsus]

Re : A propos des dates

Je crois que tu ne comprends pas comment je voudrai que le code fonctionne, donc je te fais un exemple, pour le mois de juin j'ai ces données :

mercredi 1 juin 2011
jeudi 2 juin 2011
vendredi 3 juin 2011
lundi 6 juin 2011
mardi 7 juin 2011
mercredi 8 juin 2011
jeudi 9 juin 2011
vendredi 10 juin 2011
lundi 13 juin 2011
lundi 13 juin 2011
mardi 14 juin 2011
jeudi 16 juin 2011
vendredi 17 juin 2011
lundi 20 juin 2011
lundi 20 juin 2011
mardi 21 juin 2011
lundi 20 juin 2011
mardi 21 juin 2011
mercredi 22 juin 2011
jeudi 23 juin 2011
vendredi 24 juin 2011

Comme tu vois il manque des dates, et je voudrai que la macro rajoute ces dates jusque fin juin.

P.S : merci en tout les cas de bien vouloir m'aider =)

 

[JCGL]

Re : A propos des dates

Bonjour à tous,

Peux-tu essayer avec :

Option Explicit

Sub Remplir_Dates_Manquantes()
Dim NbJ&: NbJ = ([A65536].End(xlUp) - [A1])
With Range("A1")
    .AutoFill .Resize(NbJ + 1), 5
End With
End Sub

A + à tous

Édition : je n'avais pas lu qu'il ne fallait que les jours de semaine... Désolé

 

[bond]

Re : A propos des dates

Comme tu vois il manque des dates, et je voudrai que la macro rajoute ces dates jusque fin juin

Et il y aussi des doublons et des dates intercalées, voir lundi 20 juin 2011. Quelle gestion dans ces cas ?