Tri complexe basé sur JJ et HH

**kikim78** · 09/01/2010, 12h52

Bonjour le forum,

Je suis devant un cas de tri que je trouve complexe.
A vrais dire j'ai dans la colonne B des données temps en format "jj/mm/aaaa hh:mm", donc je doit trier ou bien montionner devant chaque cellule B en cellule C ce qui suis:

Si "jj/mm/aaaa<>samedi ou dimanche" et "08:00<hh:mm<16:30" donc resultat c'est "matin"
Si "jj/mm/aaaa<>samedi ou dimanche" et "16:30<hh:mm<08:00" donc resultat c'est "soir"
Si "jj/mm/aaaa=samedi ou dimanche" et "08:01<hh:mm<08:00" donc resultat c'est "ferié"

Aussi le probleme c'est que la macro doit detecter si le jour est ferié ou pas ?!!

Merci pour l'aide

**Gorfael** · 09/01/2010, 13h57

Salut kikim78 et le forum
En C5 :

Code :

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

=SI((JOURSEM(B5;2)>5);"Férié";SI((TEMPSVAL("8:30")<(B5-TRONQUE(B5)))*((B5-TRONQUE(B5))<TEMPSVAL("16:30"));"Matin";"Soir"))

A+

**kikim78** · 09/01/2010, 14h27

Re le forum,

Merci beaucoup Gorfael, tu vien de m'apprendre quelques formules sur le temp c'est impecable.

Malheureusement ça touche pas à 100% mon objectif étant donner que je me suis très mal exprimé!

Ta raison en fin de compte!

La qualité et la précision de la réponse sont proportionnelles à celles de la question.

Le fichier ci-joint explique mieu mon but via un planning. et me demande:
Est il possible de modifier la formule de Gorfael de façon qu'elle prenne en charge mon planning ?

Merci d'avance

**jp014** · 09/01/2010, 15h00

Bonjour kikim78

Ci joint une procédure avec une interprétation de la demande.

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
Option Explicit
'ferie de 8h 01 le matin du samedi au lundi matin 8h
 
Sub travdem()
Dim cellule As Range
Dim nomfeuille1 As String
' pour boucler sur la colonne 1
Dim date1 As Date
Dim lig As Long
Dim heure As Byte
Dim minute1 As Byte
Dim jour As Byte
Dim heure1 As Date, heure2 As Date, heure3 As Date
Dim heure1c As Date, heure2c As Date
 
heure1 = TimeSerial(8, 0, 0) ' 08:00:00
heure2 = TimeSerial(16, 30, 0) '16:30:00
heure3 = TimeSerial(8, 1, 0) '08:01:00
nomfeuille1 = "Feuil1"
With Sheets(nomfeuille1)
For Each cellule In .UsedRange.Columns(2).Cells
    If IsDate(cellule.Value) Then
    jour = Weekday(cellule, vbSunday)
    'ferie de 8h 01 le matin du samedi au lundi matin 8h
    lig = recherchedate("a2:a" & Sheets("Feuil2").Cells(Rows.Count, 1).End(xlUp).Row, Format(cellule, "dd/mm/yyyy"), "Feuil2", 1)
    If lig <> 0 Then
        jour = 6 ' un jour férié est traité comme un samedi
    End If
    date1 = Format(cellule, "dd/mmm/yyyy")
    heure1c = Format(cellule, "hh:mm")
    Select Case jour
    ' samedi si heure supérieure à 8:01 h alors férié
        Case 6
            If heure1c > heure3 Then
                cellule.Offset(0, 1) = "FERIE"
            Else
                cellule.Offset(0, 1) = "SOIR"
            End If
        Case 7
            cellule.Offset(0, 1) = "FERIE"
        Case 1
            If (heure1c > heure1 And heure1c < heure2) Then cellule.Offset(0, 1) = "MATIN"
            If (heure1c > heure2) Then cellule.Offset(0, 1) = "SOIR"
        Case 2, 3, 4, 5
            If (heure1c < heure1) Then cellule.Offset(0, 1) = "SOIR"
            If (heure1c > heure1 And heure1c <= heure2) Then cellule.Offset(0, 1) = "MATIN"
            If (heure1c > heure2) Then cellule.Offset(0, 1) = "SOIR"
 
    End Select
 
   End If
Next cellule
End With
End Sub
'---------------------------------------------------------------------------------------
' Procedure : recherchedate
' Utilisation   :
'ad = "a2:" & Sheets("rue").Cells.SpecialCells(xlCellTypeLastCell).Address(0, 0) ' on recherche dans l'ensemble de la feuille
' col1 = recherchedate("A1:IV11", data1, nomfeuille1, 2)
'  rechercher une date
'---------------------------------------------------------------------------------------
'
Function recherchedate(plage_recherche As String, valcherche As Variant, nom_de_la_feuille As String, code_retour As Byte)
Dim £cel As Range
Dim £plage1 As Range
Dim £i As Integer
Dim £trouve As Boolean
 
Set £plage1 = Sheets(nom_de_la_feuille).Range(plage_recherche)
    For Each £cel In £plage1
        If IsDate(£cel) Then
            If valcherche = CStr(£cel.Value) Then
                £trouve = True
                Exit For
            End If
        End If
    Next £cel
 
If £trouve = True Then
    If code_retour = 1 Then recherchedate = £cel.Row
    If code_retour = 2 Then recherchedate = £cel.Address(0, 0)
    If code_retour = 3 Then recherchedate = £cel.Column
    If code_retour = 4 Then
       For £i = 1 To Len(£cel.Address(0, 0))
           If IsNumeric(Mid(£cel.Address(0, 0), £i, 1)) Then Exit For
           recherchedate = recherchedate & Mid(£cel.Address(0, 0), £i, 1)
       Next £i
    End If
Else
    If code_retour = 1 Then recherchedate = 0
    If code_retour = 2 Then recherchedate = ""
    If code_retour = 3 Then recherchedate = 0
    If code_retour = 4 Then recherchedate = ""
End If
End Function

Dans la feuille2 on doit trouver à partir de la ligne 2 colonne A les jours fériés de l'année.

JP014

Bonsoir

Ci dessous la procédure modifiée pour tenir compte du planning.
J'ai rajouté les heures de 16h30 à 23h59, après cette dernière heure on change de jour.
Par contre comment gérer l'heure de 08:29 avec 08:00 ?

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
Sub travdem()
Dim cellule As Range
Dim nomfeuille1 As String
' pour boucler sur la colonne 1
Dim date1 As Date
Dim lig As Long
Dim heure As Byte
Dim minute1 As Byte
Dim jour As Byte
Dim heure8 As Date, heure16 As Date  ', 'heure23 As Date
Dim heure1c As Date, heure2c As Date
'heure0 = TimeSerial(0, 0, 0) ' 08:00:00 heure0 As Date
'heure7 = TimeSerial(8, 0, 0) ' 07:59:00 heure7 As Date
heure8 = TimeSerial(8, 0, 0) ' 08:00:00
heure16 = TimeSerial(16, 30, 0) '16:30:00
'heure23 = TimeSerial(23, 59, 0) '23:59:00
 
nomfeuille1 = "Feuil1"
With Sheets(nomfeuille1)
For Each cellule In .UsedRange.Columns(2).Cells
    If IsDate(cellule.Value) Then
    jour = Weekday(cellule, vbSunday)
    'ferie de 8h 01 le matin du samedi au lundi matin 8h
    lig = recherchedate("a2:a" & Sheets("Feuil2").Cells(Rows.Count, 1).End(xlUp).Row, Format(cellule, "dd/mm/yyyy"), "Feuil2", 1)
    If lig <> 0 Then
        jour = 6 ' un jour férié est traité comme un samedi
    End If
    date1 = Format(cellule, "dd/mmm/yyyy")
    heure1c = Format(cellule, "hh:mm")
    Select Case jour
 
        'Samedi  00:00 - 07:59   Soir
        'Samedi  08:00 - 23:59  Férié
        Case 6
            If heure1c >= heure8 Then
                cellule.Offset(0, 1) = "FERIE"
            Else
                cellule.Offset(0, 1) = "SOIR"
            End If
 
        'Dimanche    00:00 - 23:59   Férié
        Case 7
            cellule.Offset(0, 1) = "FERIE"
 
        'lundi  00:00   07:59   Férié
        'Lundi   08:00 - 16:30   Matin
        'Lundi  16:31 - 23:59   Soir
        Case 1
            If heure1c < heure8 Then cellule.Offset(0, 1) = "FERIE"
            If (heure1c >= heure8 And heure1c <= heure16) Then cellule.Offset(0, 1) = "MATIN"
            If (heure1c > heure16) Then cellule.Offset(0, 1) = "SOIR"
 
        'Mardi   00:00 - 07:59   soir
        'Mardi   08:00 - 16:30   Matin
        '        16:31 - 23:59   Soir
        'Mercredi    00:00   07:59
        'Mercredi    08:00 - 16:30   Matin
        '           16:31 - 08:29   Soir
        'Jeudi   08:00 - 16:30   Matin
        '           16:31 - 08:29   Soir
        'Vendredi    08:00 - 16:30   Matin
        '           16:31 - 23:59   Soir
 
        Case 2, 3, 4, 5
 
            If (heure1c < heure8) Then cellule.Offset(0, 1) = "SOIR"
            If (heure1c >= heure8 And heure1c <= heure16) Then cellule.Offset(0, 1) = "MATIN"
            If (heure1c > heure16) Then cellule.Offset(0, 1) = "SOIR"
 
    End Select
 
   End If
Next cellule
End With
End Sub

Il reste à régler les jours fériés.
Actuellement 1 jour férié correspond à un samedi.
Des jours fériés successifs peuvent poser problème.

La procédure est facilement modifiable pour tenir compte des cas spéciaux en rajoutant le "8 ième jour"

JP014

**kikim78** · 09/01/2010, 23h02

Re le forum, bonsoir jp014,

Merci infiniment j p014pour ta macro impecable! Là comme elle est elle me fait l'affaire.

Je croit qu'il suffit maintenant d'avoir ce qui suit pour faire fasse aux différentes lacunes:

Signaler tout les plages "de 08:00 à 16:30" des jours de semaines par "Matin"
à part même plages en samedi et dimanche.

Signaler toutes autres plages en "Autre"

Est il donc possible?

Crdt,

**kikim78** · 10/01/2010, 08h52

Bonjour le forum,

Une solutation adequat ma était presenté par yvouille sur autre forum, voir Fichier ci-joint.

Crdt,

Tri complexe basé sur JJ et HH

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager