Les coefficients de pondération

Version imprimable

12/05/2023, 13h26
aouiss1m

Les coefficients de pondération

Bonjour à tous.
Je veux créer une macro qui affiche les coefficients de pondération horaire durant un mois présélectionné:
1- Demande à l'utilisateur de saisir l’année, le mois et les dates des jours fériés du mois sélectionné.
2- Afficher dans une colonne les dates avec les heures de tout le mois sélectionné

Afficher les dates avec heures du mois sur la colonne A, à partir de 7:00 du premier jour jusqu’à 7:00 du premier jour du mois suivant.
0h à 7h 7h à 17h 17h à 24h
Jour Ouvrable 0.50 1.00 1.50
Congés/Weekends 0.66 1.00 1.34
12/05/2023, 15h12
BENNASR

Bonjour

Citation:

Je veux créer une macro qui affiche ...................:

ça veut, normalement, dire que tu as des données de départ
Peux tu présenter tes données de départ ainsi qu'une simulation du résultat attendu car à mon modeste avis la demande, au moins pour moi, n'est pas claire

Salut, quelque chose comme ça peut-être ?

Code:

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
Sub CoefficientsPonderationHoraire()
    ' Déclaration des variables
    Dim annee As Integer
    Dim mois As Integer
    Dim joursFeries As String
    Dim joursFeriesArray() As String
    Dim premierJour As Date
    Dim dernierJour As Date
    Dim jour As Date
    Dim i As Integer
 
    ' Demande à l'utilisateur de saisir l'année, le mois et les dates des jours fériés du mois sélectionné
    annee = InputBox("Entrez l'année:")
    mois = InputBox("Entrez le mois (1-12):")
    joursFeries = InputBox("Entrez les dates des jours fériés du mois sélectionné (séparées par des virgules):")
 
    ' Conversion des dates des jours fériés en tableau
    If joursFeries <> "" Then
        joursFeriesArray = Split(joursFeries, ",")
        For i = LBound(joursFeriesArray) To UBound(joursFeriesArray)
            joursFeriesArray(i) = Trim(joursFeriesArray(i))
        Next i
    End If
 
    ' Calcul du premier et du dernier jour du mois sélectionné
    premierJour = DateSerial(annee, mois, 1)
    dernierJour = DateSerial(annee, mois + 1, 0)
 
    ' Écriture des en-têtes de colonnes
    Range("A1").Value = "Date et heure"
    Range("B1").Value = "Coefficient de pondération"
 
    ' Boucle sur chaque jour du mois sélectionné
    i = 2
    For jour = premierJour To dernierJour
        If Weekday(jour) = 1 Or Weekday(jour) = 7 Or IsInArray(CStr(jour), joursFeriesArray) Then
            ' Congés/Weekends: écriture des coefficients de pondération pour chaque tranche horaire
            Range("A" & i).NumberFormat = "dd/mm/yyyy hh:mm"
            Range("A" & i).Value = jour + TimeSerial(0, 0, 0)
            Range("B" & i).Value = 0.66
            i = i + 1
 
            Range("A" & i).Value = jour + TimeSerial(7, 0, 0)
            Range("B" & i).Value = 1
            i = i + 1
 
            Range("A" & i).Value = jour + TimeSerial(17, 0, 0)
            Range("B" & i).Value = 1.34
            i = i + 1
        Else
            ' Jour Ouvrable: écriture des coefficients de pondération pour chaque tranche horaire
            Range("A" & i).NumberFormat = "dd/mm/yyyy hh:mm"
            Range("A" & i).Value = jour + TimeSerial(0, 0, 0)
            Range("B" & i).Value = 0.5
            i = i + 1
 
            Range("A" & i).Value = jour + TimeSerial(7, 0, 0)
            Range("B" & i).Value = 1
            i = i + 1
 
            Range("A" & i).Value = jour + TimeSerial(17, 0, 0)
            Range("B" & i).Value = 1.5
            i = i + 1
        End If
    Next jour
 
End Sub
 
' Fonction pour vérifier si une valeur est présente dans un tableau
Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
    IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1)
End Function

12/05/2023, 16h22
aouiss1m

Coefficient pondération

Merci pour la réponse rapide.
Votre programme n'affiche pas la totalité des heures de mois sélectionné.
La boite de dialogue "jour férié" envoie bug si vide.
12/05/2023, 16h27
aouiss1m

Voici un extrait d'un tableau Excel. c'est le résultat final attendue

Coefficient pondération
Mois Avril 2023
jour heure CP
1 7h - 8h 1.00
1 8h - 9h 1.00
1 9h - 10h 1.00
1 10h - 11h 1.00
1 11h - 12h 1.00
1 12h - 13h 1.00
1 13h - 14h 1.00
1 14h - 15h 1.00
1 15h - 16h 1.00
1 16h - 17h 1.00
1 17h - 18h 1.34
1 18h - 19h 1.34
1 19h - 20h 1.34
1 20h - 21h 1.34
1 21h - 22h 1.34
1 22h - 23h 1.34
1 23h - 24h 1.34
1 0h - 1h 0.66
1 1h - 2h 0.66
1 2h - 3h 0.66
1 3h - 4h 0.66
1 4h - 5h 0.66
1 5h - 6h 0.66
2 6h - 7h 0.66
2 7h - 8h 1.00
2 8h - 9h 1.00
2 9h - 10h 1.00
2 10h - 11h 1.00
2 11h - 12h 1.00
2 12h - 13h 1.00
2 13h - 14h 1.00
2 14h - 15h 1.00
2 15h - 16h 1.00
2 16h - 17h 1.00
2 17h - 18h 1.34
2 18h - 19h 1.34
2 19h - 20h 1.34
2 20h - 21h 1.34
2 21h - 22h 1.34
2 22h - 23h 1.34
2 23h - 24h 1.34
2 0h - 1h 0.66
2 1h - 2h 0.66
2 2h - 3h 0.66
2 3h - 4h 0.66
2 4h - 5h 0.66
2 5h - 6h 0.66
3 6h - 7h 0.50
12/05/2023, 16h40
aouiss1m

Citation:

Envoyé par BENNASR

Bonjour

ça veut, normalement, dire que tu as des données de départ
Peux tu présenter tes données de départ ainsi qu'une simulation du résultat attendu car à mon modeste avis la demande, au moins pour moi, n'est pas claire

La demande est la suivante:
à chaque fin de mois je dois préparer un tableau excel qui contient:
une colonne contient les jours du mois.
une colonne contient les 24 heures de chaque jour.
une colonne contient le coefficient de pondération correspond à chaque heure.
a prendre en considération que:
Les Coefficients de Pondération de la Puissance Disponible seront comme suit:
0h à 7h 7h à 17h 17h à 24h
Jour Ouvrable 0.50 1.00 1.50
fériés/Weekends 0.66 1.00 1.34

un jour représente une période de 24 heures commençant à 06h00 un jour et finissant à 06h00 le lendemain.
un jour ouvrable est un jour qui n'est ni un jour de férié ni un jour de weekend.
un weekend représente les deux jours entre 06h00 le samedi et 06h00 le lundi.
Merci d'avance pour votre collaboration.

Voilà, ça me semble bon. Je demande le mois et l'année via des inputbox et je crée une nouvelle feuille avec le nom du mois et de l'année.
La liste des jours fériés se trouve dans la fonction Holiday, tu peux la modifier comme nécessaire.

Code:

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
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
Sub CreerTableau()
    Dim mois As Integer
    Dim annee As Integer
    Dim dernierJour As Integer
    Dim dateCourante As Date
    Dim coef As Double
    Dim j As Integer
    Dim h As Integer
 
    'Demander le mois et l'année à l'utilisateur
    mois = InputBox("Entrez le mois (1-12):")
    annee = InputBox("Entrez l'année:")
 
    'Vérifier si la feuille existe déjà
    Dim feuilleExiste As Boolean
    feuilleExiste = False
    Dim feuille As Worksheet
    For Each feuille In ThisWorkbook.Worksheets
        If feuille.Name = "Tableau " & mois & "-" & annee Then
            feuilleExiste = True
            Exit For
        End If
    Next feuille
    If feuilleExiste Then
        MsgBox "La feuille existe déjà. Veuillez choisir un autre mois et/ou année."
        Exit Sub
    End If
    'Déterminer le dernier jour du mois courant
    dernierJour = Day(DateSerial(annee, mois + 1, 0))
 
    'Créer une nouvelle feuille pour le tableau
    Set feuille = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    feuille.Name = "Tableau " & mois & "-" & annee
 
    'Remplir les en-têtes de colonne
    feuille.Cells(1, 1).Value = "Jour"
    feuille.Cells(1, 2).Value = "Heure"
    feuille.Cells(1, 3).Value = "Coefficient de Pondération"
 
    'Formater la colonne C en nombre à deux décimales
    feuille.Columns("C:C").NumberFormat = "0.00"
 
    'Remplir le tableau avec les données
    For j = 1 To dernierJour
        For h = 7 To 22
            dateCourante = DateSerial(annee, mois, j) + TimeSerial(h, 0, 0)
            If Weekday(dateCourante, vbMonday) <= 5 And Not (Holiday(dateCourante)) Then
                'Jour ouvrable
                If h < 17 Then
                    coef = 1
                Else
                    coef = 1.5
                End If
            Else
                'Férié ou week-end
                If h < 17 Then
                    coef = 1
                Else
                    coef = 1.34
                End If
            End If
            feuille.Cells((j - 1) * 24 + h - 6 + 1, 1).Value = j
            feuille.Cells((j - 1) * 24 + h - 6 + 1, 2).Value = Format(TimeSerial(h, 0, 0), "hh""h"" - ") & Format(TimeSerial(h + 1, 0, 0), "hh""h""") ' plage horaire
            feuille.Cells((j - 1) * 24 + h - 6 + 1, 3).Value = coef
        Next h
        'Ajouter la plage horaire de 23h à 24h
        dateCourante = DateSerial(annee, mois, j) + TimeSerial(23, 0, 0)
        If Weekday(dateCourante, vbMonday) <= 5 And Not (Holiday(dateCourante)) Then
            'Jour ouvrable
            coef = 1.5
        Else
            'Férié ou week-end
            coef = 1.34
        End If
        feuille.Cells((j - 1) * 24 + 23 - 6 + 1, 1).Value = j
        feuille.Cells((j - 1) * 24 + 23 - 6 + 1, 2).Value = "23h - 24h"
        feuille.Cells((j - 1) * 24 + 23 - 6 + 1, 3).Value = coef
        'Ajouter la plage horaire de 0h à 1h
        dateCourante = DateSerial(annee, mois, j) + TimeSerial(0, 0, 0)
        If Weekday(dateCourante, vbMonday) <= 5 And Not (Holiday(dateCourante)) Then
            'Jour ouvrable
            coef = 0.5
        Else
            'Férié ou week-end
            coef = 0.66
        End If
        feuille.Cells((j - 1) * 24 + 24 - 6 + 1, 1).Value = j
        feuille.Cells((j - 1) * 24 + 24 - 6 + 1, 2).Value = "00h - 01h"
        feuille.Cells((j - 1) * 24 + 24 - 6 + 1, 3).Value = coef
        For h = 1 To 6
            dateCourante = DateSerial(annee, mois, j) + TimeSerial(h, 0, 0)
            If Weekday(dateCourante, vbMonday) <= 5 And Not (Holiday(dateCourante)) Then
                'Jour ouvrable
                coef = 0.5
            Else
                'Férié ou week-end
                coef = 0.66
            End If
            feuille.Cells((j - 1) * 24 + h + 24 - 6 + 1, 1).Value = j
            feuille.Cells((j - 1) * 24 + h + 24 - 6 + 1, 2).Value = Format(TimeSerial(h, 0, 0), "hh""h"" - ") & Format(TimeSerial(h + 1, 0, 0), "hh""h""") ' plage horaire
            feuille.Cells((j - 1) * 24 + h + 24 - 6 + 1, 3).Value = coef
        Next h
    Next j
 
    'Mettre en forme le tableau
    feuille.Columns.AutoFit
    feuille.Rows(1).Font.Bold = True
End Sub
Function Holiday(dt As Date) As Boolean
    Dim holidays As Variant
    holidays = Array(#1/1/2023#, #4/3/2023#, #4/4/2023#, #5/1/2023#, #5/8/2023#, #5/22/2023#, #6/5/2023#, #7/14/2023#, #8/15/2023#, #11/1/2023#, #11/11/2023#, #12/25/2023#)
    Dim i As Integer
    For i = LBound(holidays) To UBound(holidays)
        If DateValue(holidays(i)) = DateValue(dt) Then
            Holiday = True
            Exit Function
        End If
    Next i
    Holiday = False
End Function