comment faire pr mettre a mon code les jours de la semaine sans le week end

**alexandrek** · 09/02/2011, 17h37

Bonjour,

Pour expliquer au mieux mon problème, j'ai une cellule avec une date de transaction et une cellule avec une date de settlement. (C5 et C8)

Ces dates me permettent si elles respectent certaines conditions de remplir une autre cellule dans un onglet Sh .Voici le code de départ pour que vous voyez mieux .

Est il possible que ces Today + 1 ou + 2 ou > 3, ne soit compris qu entre lundi et vendredi inclut ?

(Peut etre je ne l exprime pas au mieux donc je laisse un exemple concret )
Dans le cas ou Today serait vendredi ....

Par Exemple C5 (= vendredi 11 Fevrier) et que C8 (= Lundi 14 Fevrier); la cellule C7 devrait renvoyer TOM ? (Car ça serait Today + 1 )

Dans mon code le probleme c est qu elle renvoie Forward ....

Merci d'avance

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
 
               Sh.Range("C5").Value = today
               Sh.Range("C8").Value = .Cells(c.Row, "F").Value
 
If Sh.Range("C8").Value = Range("C5") Then
Sh.Range("C7").Value = "TODAY"
End if
 
If  Sh.Range("C8") = today + 1 Then
Sh.range("C7").value = "TOM"
End if 
 
If Sh.Range("C8") = today + 2 Then
Sh.range("C7").value = "SPOT"
End if 
 
If Sh.Range("C8") >= today + 3 Then
Sh.range("C7").value  = "FORW"
End If

**zazaraignée** · 09/02/2011, 21h35

Il y a la fonction Weekday... Voici un exemple :

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
Sub DeuxSemainesJoursOuvrables()
    Dim cellule As Range
    Dim CeJour As Date
    Dim i As Integer
    i = 0
    CeJour = Date
    For Each cellule In Range("A1:A10")  ' plage de 10 cellules
        cellule.Value = CeJour + i
        i = i + 1
        If Weekday(cellule) = 1 Then        ' dimanche
            ' quoi qu'il y ait peut de chances de passer par ici
            cellule.Value = cellule.Value + 1
            i = i + 1
          ElseIf Weekday(cellule) = 7 Then  ' samedi
            cellule.Value = cellule.Value + 2
            i = i + 2
        End If
        cellule.NumberFormat = "yyyy/MM/dd"
    Next
End Sub

**alexandrek** · 09/02/2011, 21h42

Merci mais je vois pas trop comment le faire varier entre le lundi et le vendredi ... en faite c est l'adapter à mon code où j'ai du mal ...

arfff vba , Il y a de quoi s'arracher les cheveux lol

**zazaraignée** · 09/02/2011, 21h47

Cet exemple

entre la date du jour (au format numérique d'abord),
vérifie si la date entrée dans la cellule est un dimanche ou un samedi,
la corrige en conséquence,
et modifie le format de cellule pour afficher année-mois-jour : 2011-02-09

Et il faudra adapter.

**alexandrek** · 09/02/2011, 22h02

Un truc me chagrine sur cet exemple, c'est que ma date entrée dans la cellule ne sera jamais un week end, un samedi et un dimanche... donc pourquoi tester cela ...

en faite, j'ai du mal m'exprimer, mon problème c est ça ;

C5 (= vendredi 11 Fevrier) et que C8 (= Lundi 14 Fevrier); la cellule C7 devrait renvoyer TOM ? (Car ça serait Today + 1 )

Dans mon code le probleme c est qu elle renvoie Forward ....

Je cherche à exclure le samedi et le dimanche en faite

**pgz** · 09/02/2011, 22h08

Bonsoir a vous deux.

Une suggestion : Si le samedi n'était pas neutralisé, on aurait pu utiliser la fonction de feuille NB.JOURS.OUVRES.
Mais on peut se faire une fonction perso

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
Function fNbJoursSem(ByVal DateDeb As Date, ByVal DateFin As Date) As Variant
Dim dte As Date
 
Application.Volatile
 
If DateDeb >= DateFin Then
    fNbJoursSem = "!Erreur!"
Else
    fNbJoursSem = 0
    For dte = DateDeb + 1 To DateFin
        If Weekday(dte, vbMonday) < 6 Then fNbJoursSem = fNbJoursSem + 1
    Next dte
End If
 
End Function

Bien sûr, il faudrait voir s'il ne faut pas neutraliser aussi les jours fériés. Et si oui de quel pays!

Ensuite ça peut s'utiliser comme cela

Code :

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

1
2
3
4
5
6
7
8
9
10
Select Case fNbJoursSem(Date, sh.Range("C8"))
    Case 0
        sh.Range("C7") = "TODAY"
    Case 1
        sh.Range("C7") = "TOM"
    Case 2
        sh.Range("C7") = "SPOT"
    Case Is >= 3
        sh.Range("C7") = "FORW"
End Select

J'aurais bien utilisé un CHOOSE, mais le >= 3 gêne.

Cordialement,

PGZ

**mercatog** · 09/02/2011, 22h13

Une proposition

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
Function DiffJour(Dte1 As Date, Dte2 As Date) As Integer
 
If Weekday(Dte1, vbSaturday) <= 2 Then Dte1 = DateAdd("d", 3 - Weekday(Dte1, vbSaturday), Dte1)
If Weekday(Dte2, vbSaturday) <= 2 Then Dte2 = DateAdd("d", -Weekday(Dte2, vbSaturday), Dte2)
DiffJour = DateDiff("d", Dte1, Dte2, vbMonday) - 2 * DateDiff("ww", Dte1, Dte2, vbMonday)
End Function
 
Sub Test()
Dim Sh As Worksheet
 
Set Sh = Sheets("Feuil1")
With Sh
   Select Case DiffJour(.Range("C5").Value, .Range("C8").Value)
      Case 0: .Range("C7").Value = "TODAY"
      Case 1: .Range("C7").Value = "TOM"
      Case 2: .Range("C7").Value = "SPOT"
      Case Is >= 3: .Range("C7").Value = "FORW"
   End Select
End With
End Sub

**alexandrek** · 09/02/2011, 22h17

Bonsoir pgz et mercatog,

Merci tout d'abord les jours fériés c est pas grave, il faut juste que j'exclus le samedi et le dimanche ....

sachant que mon code s'active en un clique droit cela ne va pas etre compromis du fait de la présence de la function ou j'insére la Function DiffJour dans mon module et dans mon code je peux mettre juste le With Sh et end with ???

Je vous joins le code pour avoir votre avis

Dans mon module j'insére ma function diffjour

Code :

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

1
2
3
4
5
6
7
 
Function DiffJour(Dte1 As Date, Dte2 As Date) As Integer
 
If Weekday(Dte1, vbSaturday) <= 2 Then Dte1 = DateAdd("d", 3 - Weekday(Dte1, vbSaturday), Dte1)
If Weekday(Dte2, vbSaturday) <= 2 Then Dte2 = DateAdd("d", -Weekday(Dte2, vbSaturday), Dte2)
DiffJour = DateDiff("d", Dte1, Dte2, vbMonday) - 2 * DateDiff("ww", Dte1, Dte2, vbMonday)
End Function

et dans ma page le With

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
 
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim c As Range, Plage As Range
Dim LastLig As Long
Dim Sh As Worksheet
Dim today as date 
 
Date = today
Cancel = True
LastLig = Cells(Rows.Count, "D").End(xlUp).Row
Set Plage = Intersect(Target, Range("D27:D" & LastLig))
If Not Plage Is Nothing Then
   Application.ScreenUpdating = False
   For Each c In Plage
      If Trim(c.Value) <> "" Then
         If MsgBox("Do you want book Ticket for " & CStr(Format(c.Value, "00000")) & "?", vbOKCancel + vbQuestion, "Booking Program") = vbOK Then
            Call Crea_Page(c)
            Set Sh = Sheets(CStr(Format(c.Value, "00000")))
            With Sheets("BOOK")
               Sh.Range("C4").Value = c.Value
               Sh.Range("C5").Value = today               
               Sh.Range("C8").Value = .Cells(c.Row, "F").Value
 
With Sh
   Select Case DiffJour(.Range("C5").Value, .Range("C8").Value)
      Case 0: .Range("C7").Value = "TODAY"
      Case 1: .Range("C7").Value = "TOM"
      Case 2: .Range("C7").Value = "SPOT"
      Case Is >= 3: .Range("C7").Value = "FORW"
   End Select
End With
 
               Sh.Range("C6").Value = .Cells(c.Row, "A").Value
               Sh.Range("C9").Value = .Cells(c.Row, "K").Value & "/" & .Cells(c.Row, "L").Value
 
              If .Cells(c.Row, "G").Value > 0 Then
                  Sh.Range("C11").Value = .Cells(c.Row, "K").Value
                  Sh.Range("C12").Value = .Cells(c.Row, "L").Value
                  Sh.Range("D11").Value = .Cells(c.Row, "G").Value
                  Sh.Range("D12").Value = .Cells(c.Row, "H").Value
               Else
                  Sh.Range("C11").Value = .Cells(c.Row, "L").Value
                  Sh.Range("C12").Value = .Cells(c.Row, "K").Value
                  Sh.Range("D11").Value = .Cells(c.Row, "H").Value
                  Sh.Range("D12").Value = .Cells(c.Row, "G").Value
               End If
               Sh.Range("D11:D12").NumberFormat = "0.00"
               Sh.Range("C13").Value = .Cells(c.Row, "M").Value
               .Activate
            End With
            Set Sh = Nothing
         End If
      End If
   Next c
End If
Set Plage = Nothing
End Sub

**mercatog** · 09/02/2011, 22h43

Dans le même module de ta feuille

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
Private Function DiffJour(Dte1 As Date, Dte2 As Date) As Integer
 
If Weekday(Dte1, vbSaturday) <= 2 Then Dte1 = DateAdd("d", 3 - Weekday(Dte1, vbSaturday), Dte1)
If Weekday(Dte2, vbSaturday) <= 2 Then Dte2 = DateAdd("d", -Weekday(Dte2, vbSaturday), Dte2)
DiffJour = DateDiff("d", Dte1, Dte2, vbMonday) - 2 * DateDiff("ww", Dte1, Dte2, vbMonday)
End Function
 
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim Sh As Worksheet
Dim c As Range, Plage As Range
Dim LastLig As Long
Dim Comnt As String
 
Cancel = True
LastLig = Cells(Rows.Count, "D").End(xlUp).Row
Set Plage = Intersect(Target, Range("D27:D" & LastLig))
If Not Plage Is Nothing Then
   Application.ScreenUpdating = False
   For Each c In Plage
      If Trim(c.Value) <> "" Then
         If MsgBox("Do you want book Ticket for " & CStr(Format(c.Value, "00000")) & "?", vbOKCancel + vbQuestion, "Booking Program") = vbOK Then
            'Call Crea_Page(c)
            Set Sh = Sheets(CStr(Format(c.Value, "00000")))
            With Sheets("BOOK")
               Sh.Range("C4").Value = Format(c.Value, "00000")
               Sh.Range("C5").Value = Date
               Sh.Range("C8").Value = .Cells(c.Row, "F").Value
               Select Case DiffJour(Sh.Range("C5").Value, Sh.Range("C8").Value)
                  Case 0: Comnt = "TODAY"
                  Case 1: Comnt = "TOM"
                  Case 2: Comnt = "SPOT"
                  Case Is >= 3: Comnt = "FORW"
               End Select
               Sh.Range("C7").Value = Comnt
               Sh.Range("C6").Value = .Cells(c.Row, "A").Value
               Sh.Range("C9").Value = .Cells(c.Row, "K").Value & "/" & .Cells(c.Row, "L").Value
               Comnt = ""
 
               If .Cells(c.Row, "G").Value > 0 Then
                  Sh.Range("C11").Value = .Cells(c.Row, "K").Value
                  Sh.Range("C12").Value = .Cells(c.Row, "L").Value
                  Sh.Range("D11").Value = .Cells(c.Row, "G").Value
                  Sh.Range("D12").Value = .Cells(c.Row, "H").Value
               Else
                  Sh.Range("C11").Value = .Cells(c.Row, "L").Value
                  Sh.Range("C12").Value = .Cells(c.Row, "K").Value
                  Sh.Range("D11").Value = .Cells(c.Row, "H").Value
                  Sh.Range("D12").Value = .Cells(c.Row, "G").Value
               End If
               Sh.Range("D11:D12").NumberFormat = "0.00"
               Sh.Range("C13").Value = .Cells(c.Row, "M").Value
               .Activate
            End With
            Set Sh = Nothing
         End If
      End If
   Next c
End If
Set Plage = Nothing
End Sub

**alexandrek** · 09/02/2011, 22h53

ok, je pensais que cette function aller compromettre ma procédure principale...

ah ok en lisant les corrections que tu as apporté, déjà la date j'avais pas besoin de déclarer cette variable du coup.

En faite, je comprends tu passes par la variable Comnt....

pff en 10 minutes tu as résolu un problème que je cherche depuis des jours lol

Un véritable grand merci ...

Demain matin, j'essaye direct cela ....

Cordialement

comment faire pr mettre a mon code les jours de la semaine sans le week end [XL-2007]

Macros et VBA Excel

Discussions similaires

Partager

Partager