Discussion :

[jeje00]

Bonjour,

J'aimerais programmer cet algorithme en VBA Excel mais je cale completement :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Public Function retourne_temps_a_soustraire(ByVal Date_ancienne, ByVal Date_nouvelle) as Integer
 
Si entre Date_ancienne et Date_nouvelle, il y a eu un Samedi entre 11h00 et 23h00 alors retourne_temps_a_soustraire = 1
Si entre Date_ancienne et Date_nouvelle, il y a eu un Dimanche entre 11h00 et 23h00 alors retourne_temps_a_soustraire = 1
Si entre Date_ancienne et Date_nouvelle, il y a eu un Samedi entre 11h00 et 23h00 et un Dimanche entre 11h00 et 23h00 alors retourne 12h00, alors retourne 2
 
Si entre Date_ancienne et Date_nouvelle, il y a eu deux Samedi entre 11h00 et 23h00 et un Dimanche entre 11h00 et 23h00 alors retourne_temps_a_soustraire = 3
 
Si entre Date_ancienne et Date_nouvelle, il y a eu deux Samedi entre 11h00 et 23h00 et deux Dimanche entre 11h00 et 23h00 alors retourne_temps_a_soustraire = 4
 
Sinon retourne_temps_a_soustraire = 0
 
End Function

Exemple 1 :
Date_ancienne(code par un now()) = 39969.5833333333 (Vendredi 5/06 14h00)
Date_nouvelle(code par un now()) = 39973.4166666667 (Mardi 9/06 10h00)

Je veux obtenir : retourne_temps_a_soustraire = 2 (car il y a eu le samedi 6/06 entre 11h00 et 23h00 ET le dimanche 7/06 entre 11h00 et 23h00)

Exemple 2 :
Date_ancienne(code par un now()) = 39969.5833333333 (Vendredi 5/06 14h00)
Date_nouvelle(code par un now()) = 39971.375 (Dimanche 7/06 9h00)

Je veux obtenir : retourne_temps_a_soustraire = 1 (car il y a eu le samedi 6/06 entre 11h00 et 23h00)

Exemple 3 :
Date_ancienne(code par un now()) = 39969.5833333333 (Vendredi 5/06 14h00)
Date_nouvelle(code par un now()) = 39978.375 (Dimanche 14/06 9h00)

Je veux obtenir : retourne_temps_a_soustraire = 3 (car il y a eu le samedi 6/06 entre 11h00 et 23h00 ET le dimanche 7/06 entre 11h00 et 23h00) et le samedi 13/06 entre 11h00 et 23h00)


Merci pour votre aide

[Krovax]

Bonjour,
Visiblement tu n'as pas eu beaucoup de succés voila quelque piste pour ton programme
La FAQ VBA Acesse (même principe qu pour VBA Excel) pour les Dates et Heures

Tu devrais pouvoir y trouver comment récupérer le jour de la semaine et ainsi pouvoir tester s'il y a bien eu des samedi et dimanche (tu peux même avoir les jour férié, mais ca je ne sais pas si cela te sera utile)
Bonne chance pour ton code

[jeje00]

Merci pour le lien, a vrai dire c'est plutot l'algo qui me pose probleme plutot que les fonctions excel que je commence a bien connaitre maintenant.
Sur des dates precises j'ai reussi la detection mais pour tous les samedis et dimanches j'y arrive pas meme avec weekday.
Faut que je creuse encore je vais bien finir par y arriver

[Invité]

Bonjour,

Je n'ai pas cherché très loin, mais j'ai fait quelques essais, est-ce que ce code pourrais convenir ?

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
datd = "06/06/09"
datf = "24/06/09"
nbj1 = DateDiff("d", datd, datf)
nbj2 = nbj1
hrd = "11:00"
hrf = "23:00"
jd = Weekday(datd, 2)
jf = Weekday(datf, 2)
 
For i = 1 To nbj1
    If i = 1 And jd = 6 And hrd >= "11:00" And hrf <= "23:00" Then
    nbj2 = nbj2 - 1
    ElseIf i = 1 And jf = 6 And hrd >= "11:00" And hrf <= "23:00" Then
    nbj = nbj - 1
    Else
    j = DateAdd("d", i - 1, datd)
    j = Weekday(j, 2)
        If j = 6 And hrd >= "11:00" And hrf <= "23:00" Then
        nbj2 = nbj2 - 1
        End If
 
        If j = 7 And hrd >= "11:00" And hrf <= "23:00" Then
        nbj2 = nbj2 - 1
        End If
 
End If
Next

Même si c'est le cas, c'est sans doute à améliorer.

J'ai réalisé que cette partie :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

And hrd >= "11:00" And hrf <= "23:00" Then

ne devait fonctionner que par hasard, mais je n'ai plus le temps ce soir.

[Invité]

En fait, après rectification :

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
 
datd = "06/06/09"
datf = "24/06/09"
nbj1 = DateDiff("d", datd, datf)
nbj2 = nbj1
hrd = "10:00"
hrf = "23:00"
jd = Weekday(datd, 2)
jf = Weekday(datf, 2)
 
For i = 1 To nbj1
    If i = 1 And jd = 6 And hrd >= "11:00" And hrf <= "23:00" Then
    nbj2 = nbj2 - 1
    ElseIf i = 1 And jf = 6 And hrd >= "11:00" And hrf <= "23:00" Then
    nbj = nbj - 1
    Else
    j = DateAdd("d", i - 1, datd)
    j = Weekday(j, 2)
        If j = 6 Then
        nbj2 = nbj2 - 1
        End If
 
        If j = 7 Then
        nbj2 = nbj2 - 1
        End If
 
End If
Next

A vérifier.