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 |
