Majoration en fonction des heures

Version imprimable

05/06/2019, 10h56
Shaplow

1 pièce(s) jointe(s)

Majoration en fonction des heures

Bonjour,

Je suis en train de créer une macro Excel mais je bloque sur un problème: j'ai 4 colonnes, une avec les heures de début, l'autre avec les heures de fin, une avec la durée (entre ces 2 horaires) et enfin une avec les jour. J'aimerai faire des tarifs majorés en fonction de ces colonnes donc jusque là ça va, avec quelques if on s'en sort mais j'ai un soucis. Prenons un exemple, on est samedi, l'heure de début indique 18h, l'heure de fin indique 22h30 et la durée 4h30 et imaginons maintenant que entre 18h à 19h ce soit non majoré, entre 19h et 21h30 majoré de 25% et de 21h30 à 22h30 majoré de 50%, comment je peux faire ? Je n'arrive pas à trouver de solution si quelqu'un à une piste je suis preneur !

Merci d'avance !

Edit: Voici le tableau des majorations à appliquer si ça peut-être utile

Pièce jointe 480910
05/06/2019, 14h56
Shaplow

J'ai entendu parler du select case, ça peut marcher ?
05/06/2019, 15h52
Patrice740

1 pièce(s) jointe(s)

Bonjour,

Citation:

Envoyé par Shaplow

J'ai entendu parler du select case, ça peut marcher ?

Pourquoi pas !
Ce n'est qu'une autre façon d'écrire If Then

Pour ma part, je me passerais du VBA, Excel est avant tout un outil de calcul parfaitement adapté à ce genre de problème relativement simple.
Par contre j'utiliserais tableau plus facile à exploiter, par exemple :
Pièce jointe 481014
05/06/2019, 16h12
Shaplow

Salut, merci de ta réponse !

En gros je suis en stage en entreprise et les employés recoivent un fichier excel un peu barbare d'un logiciel et le but derrière c'est qu'ils lancent la macro et tous les calculs se font automatiquement ainsi que l'organisation des différents tableaux, du coup comment ne pas utiliser VBA mais automatiser la chose quand même haha ?

Merci pour le tableau, j'avais fait l'autre à l'arrache pour expliquer, je me doutais bien que j'aurai galéré sous cette forme !
05/06/2019, 16h31
Patrice740

Re,

Je répète :

Citation:

Envoyé par Patrice740

...Excel est avant tout un outil de calcul parfaitement adapté à ce genre de problème relativement simple.

D'autre part, il est plus facile d'appendre à utiliser Excel que d'apprendre la programmation.

L'inconvénient MAJEUR étant que, ton stage terminé, personne ne seras en mesure de maintenir ton code en état de fonctionnement et ton "outil" tombera très rapidement en désuétude !!!
05/06/2019, 16h48
Mickamax

Bonjour,
Si le fichier à traiter viens effectivement d'une extraction d'un logiciel, une macro VBA semble être une meilleure idée que de réécrire les fonctions "à la mano" à chaque extraction.
Pourrais-tu envoyer une copie de ton fichier ?

Mickamax
05/06/2019, 16h49
Shaplow

J'entends bien tes arguments mais moi mon but c'est d'apprendre la programmation, alors certes je suis pas du tout à l'aise avec VBA je connais ce langage que depuis quelques jours du coup je nage un peu parce que c'est différent de ce qu'on a vu mais je m'adapte. Ensuite j'ai pris les précautions pour que justement mon code reste fonctionnel le plus longtemps possible ! Le fichier que sort le logiciel a des bases qui restent toujours pareil donc j'ai fait en sorte d'utiliser ces bases pour mon programme comme ça il fonctionnera le plus longtemps possible et au final même si il marche pas très longtemps c'est pas grave j'aurai acquis de l'expérience !

Du coup merci de ton aide, mais là tu contournes mon problème alors que moi je cherche une solution haha

1 pièce(s) jointe(s)

Citation:

Envoyé par Mickamax

Bonjour,
Si le fichier à traiter viens effectivement d'une extraction d'un logiciel, une macro VBA semble être une meilleure idée que de réécrire les fonctions "à la mano" à chaque extraction.
Pourrais-tu envoyer une copie de ton fichier ?

Mickamax

Salut, merci de ton aide !

Oui biensûr, est-ce que le code te suffit ? Il y a des informations confidentielles dans le fichier mais si jamais tu en as réellement besoin je peux les enlever et t'envoyer ça demain ;)

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
Sub GESTION_TEMPS()
'
' GESTION_TEMPS Macro
'
' Touche de raccourci du clavier: Ctrl+h
 
'
    '
    ' Déclaration des variables
    '
 
    Dim plage As Range, reg As Range, firstAdd As String, cel As Range
 
    '
    ' Défusion des cellules
    '
 
    Cells.Select
    With Selection
        .VerticalAlignment = xlBottom
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
 
    '
    ' Separer les différents tableaux avec la position
    '
 
    Set plage = Worksheets("export").Cells
    Set reg = plage.Find(What:="Sem n°")
 
 
    If Not reg Is Nothing Then
        firstAdd = reg.Address
        Do
            reg.CurrentRegion.Copy
            Sheets.Add After:=ActiveSheet
            ActiveSheet.Paste
            Set reg = plage.FindNext(reg)
        Loop While Not reg Is Nothing And reg.Address <> firstAdd
    End If
 
 
    '
    ' Réorganisation des tableaux
    '
 
    Dim sh As Worksheet
    For Each sh In ActiveWorkbook.Sheets
    sh.Activate
    If sh.Name <> "export" Then
 
        'Changement des noms des feuilles
        sh.Name = Right(ActiveSheet.Range("A1").Value, Len(ActiveSheet.Range("A1").Value) - InStr(ActiveSheet.Range("A1").Value, ":"))
        Columns("H:H").Select
        'Réorga
        Selection.Delete Shift:=xlToLeft
        Selection.Delete Shift:=xlToLeft
        'Début: Mise en place des horaires
        Columns("E:E").Select
        Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
        Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
        Columns("D:D").Select
        Application.DisplayAlerts = False
        Selection.TextToColumns Destination:=Range("D1"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(5, 1), Array(7, 1)), TrailingMinusNumbers:= _
        True
        Application.DisplayAlerts = True
        Columns("E:E").Select
        Selection.Delete Shift:=xlToLeft
        Range("D2").Select
        ActiveCell.FormulaR1C1 = "Horaires début"
        Range("E2").Select
        ActiveCell.FormulaR1C1 = "Horaires fin"
        'Mise en place sous-totaux
        For Each cel In Range("A3", Range("A3").End(xlDown))
            If cel.Value <> cel.Offset(1, 0).Value And cel.Value <> "" And cel.Value <> "Sous-total:" Then 'Ajouter ici toutes les values des cellules de la colonne A pour ne pas faire buguer
                cel.Select
                Selection.Offset(1).EntireRow.Insert
                Selection.Offset(1).Value = "Sous-total:"
                Selection.Offset(1).Font.Bold = True
                'Selection.Offset(1, 3).FormulaLocal = "=SOUS.TOTAL(9)" https://www.generation-nt .com/reponses/sous-total-vba-entraide-482931.html
                With Selection.Offset(1).Resize(1, 12).Interior
                    .Pattern = xlSolid
                    .PatternColorIndex = xlAutomatic
                    .ThemeColor = xlThemeColorDark2
                    .TintAndShade = 0
                    .PatternTintAndShade = 0
                End With
            End If
        Next cel
 
 
 
        ' Pour la majoration regarder le select case
 
 
    End If
    Next sh
 
End Sub

Edit: J'ai un photo d'un des tableaux que le logiciel m'envoie de base, il y en a pleins sur une page mais je les ai séparer dans différentes feuilles pour les réorganiser

Pièce jointe 481079

Edit 2: En fait je crains que tout ceci ne serve à rien puisque j'ai même pas commencé à coder les majorations vu que je ne sais même pas comment démarrer :?

05/06/2019, 17h35
Philippe Tulliez

1 pièce(s) jointe(s)
Bonjour,
Avec ou sans VBA, je commencerais par la création de quatre tableaux structurés de deux colonnes chacun
- Le premier tableau avec trois lignes en colonne 1, les valeurs 1, 6, 7 et en colonne 2 le nom du tableau où se trouve les heures à majorer
- Les trois autres tableaux auront autant de lignes qu'il n'y a de tranches horaires à majorer (Colonne 1 l'heure de début de la majoration, colonne 2 le taux majoré)
La fonction JOURSEM permettra de connaître le n° du jour de la semaine soit 1 à 5 pour lundi à vendredi, 6 pour samedi et 7 pour dimanche
Si tu utilises la fonction RECHERCHEV avec valeur proche, tu pourras connaître le tableau à consulter suivant le jour

Pour les jours fériés, il faudra prévoir un autre tableau avec les jours fériés et si la date fait partie de celle-ci, lui donner 7 comme valeur à chercher (ainsi dimanche et jour fériés même tableau)

En cas de non connaissance des tableaux structurés et la fonction RECHERCHEV, je te conseille la lecture de
- Fonctions Excel à la loupe : N°1 - RECHERCHEV()
- Apprendre à utiliser les tableaux structurés Excel : création, manipulations et avantages(1)
Dans l'illustration ci-dessous,
On recherche le tableau à consulter (T_Normal pour les jours normaux, T_Samedi et T_Dimanche pour les autres) en colonne E de la feuille [Encodage] avec la formule

Code:

=RECHERCHEV(JOURSEM([@Date];2);T_ReferenceDay;2)

En colonne F de la même feuille on renvoie le taux de majoration avec la formule

Code:

=RECHERCHEV([@Début];INDIRECT([@c1]);2)

La difficulté réside au calcul pour les différentes tranches horaires (on voit en ligne 1 d'ailleurs que la formule renvoie 0% alors que à partir de 14:00 et jusqu'à 18:00, il y aurait lieu de majorer de 25%

C'est une piste
Une fonction en VBA sera certainement plus rapide à développer mais en Excel, il faudrait travailler par palier (un peu comme les calculs d'impôts) mais je n'ai pas le temps de me pencher sur le problème. Il faudrait donc certainement ajouter une ou des colonnes aux tableaux de la feuille [Parameter]

Illustration des tableaux
Pièce jointe 481098
06/06/2019, 20h18
Shaplow

Merci merci beaucoup, je vais creusé de mon côté maintenant grâce à tes infos !

Bonne soirée
07/06/2019, 15h12
Shaplow

Re, après étude du problème est-il possible d'avoir des informations en plus concernant les colonnes à rajouter et les paliers ? J'ai du mal à saisir comment je peux découper mes heures pour faire en sorte que plusieurs majorations s'appliquent pour une tranche d'horaire.

Merci de prendre du temps pour me répondre !

1 pièce(s) jointe(s)

Bonjour,

Une façon de faire an créant des fonctions spéciales en VBA.
Comme c'est un peu tordu, bien vérifier, en particulier pour vendredi, samedi, dimanche, lundi.

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
121
122
123
124
125
126
127
128
129
130
131
132
Option Explicit
 
Const H_1 As Date = #6:30:00 AM#    '--- fin de nuit
Const H_2 As Date = #9:00:00 AM#    '--- fin tôt le matin
Const H_3 As Date = #2:00:00 PM#    '--- début soir samedi
Const H_4 As Date = #7:00:00 PM#    '--- début soir semaine
Const H_5 As Date = #9:30:00 PM#    '--- début de nuit
 
'--- les -0.0001 nécessaires pour éviter problèmes avec minuit: la date change à 00h00'00""
'--- ne traite pas le cas où le temps dépasse 24h consécutives
 
Public Function hTrf4(dD1 As Date, sF1 As String, dD2 As Date, sF2 As String) As Variant
    '--- calcul heures au tarif 4 - dimanche et jour férié
    Debug.Print dD1, sF1, dD2, sF2
    If Int(dD2 - 0.0001) = Int(dD1) Then
        '--- jour fin = jour début
        If sF1 = "x" Or sF2 = "x" Then  '--- jour marqué férié
            If (sF1 & sF2) = "xx" Then
                hTrf4 = dD2 - dD1       '--- férié: tout au tarif 4
            Else
                hTrf4 = "? férié"       '--- anomalie: manque un x
            End If
        Else
            If Weekday(dD2) = 1 Then
                hTrf4 = dD2 - dD1       '--- dimanche: tout au tarif 4
            Else
                hTrf4 = 0               '--- autre jour
            End If
        End If
    ElseIf Int(dD2 - 0.00001) > Int(dD1) Then
        '--- jour fin > jour début
        If sF1 = "x" Then
            '--- jour début est férié
            If sF2 = "x" Or Weekday(dD2) = 1 Then
                hTrf4 = dD2 - dD1       '--- jour fin est férié ou dimanche
            Else
                hTrf4 = Int(dD2) - dD1  '--- jour fin est autre
            End If
        Else
            '--- jour début n'est pas férié
            If sF2 = "x" Or Weekday(dD2) = 1 Then
                hTrf4 = dD2 - Int(dD2)  '--- jour fin est férié ou dimanche
            Else
                hTrf4 = 0               '--- jour fin est autre
            End If
        End If
    Else
        hTrf4 = "fin < début?"          '--- anomalie
    End If
End Function
 
Public Function hTrf3(dD1 As Date, sF1 As String, dD2 As Date, sF2 As String) As Variant
    '--- calcul heures au tarif 3: nuit de H_5 (21h30) à H_1 (06h30)
    Dim hTot As Double, hDeb As Double, hFin As Double
    Debug.Print dD1, sF1, dD2, sF2
    If Int(dD2 - 0.00001) = Int(dD1) Then
        '--- début et fin sur la même journée
        If Weekday(dD2) = 1 Or sF1 = "x" Or sF2 = "x" Then  '--- dimanche ou férié
            hTot = 0
        Else
            hTot = 0
            hDeb = dD1 - Int(dD1)
            hFin = dD2 - Int(dD2)
            If hFin = 0 Then hFin = 1   '--- correction pour minuit
            If hDeb < H_1 Then              '--- début avant 6h30
                If hFin > H_1 Then
                    hTot = H_1 - hDeb       '--- fin après 6h30
                Else
                    hTot = hFin - hDeb      '--- fin avant 6h30
                End If
            End If
            If hFin > H_5 Then                  '--- fin après 21h30
                If hDeb < H_5 Then
                    hTot = hTot + hFin - H_5    '--- début avant 2130
                Else
                    hTot = hTot + hFin - hDeb   '--- début après 6h30
                End If
            End If
        End If
    ElseIf Int(dD2 - 0.00001) > Int(dD1) Then
        '--- fin jour après début
        hTot = hTrf3(dD1, sF1, Int(dD2), sF1) + hTrf3(Int(dD2), sF2, dD2, sF2)
    Else
        hTot = "fin < début?"   '--- anomalie
    End If
    hTrf3 = hTot
End Function
 
Public Function hTrf1(dD1 As Date, sF1 As String, dD2 As Date, sF2 As String) As Variant
    '--- calcul heures au tarif 1: 100%
    '--- en semaine: entre H_2 (09h00) et H_4 (19h00)
    '--- le samedi:entre H_2 (09h00) et H_3 (14h00)
    Dim hTot As Double, hDeb As Double, hFin As Double, H_Fin As Date
    Debug.Print dD1, sF1, dD2, sF2
    If Int(dD2 - 0.00001) = Int(dD1) Then
        '--- début et fin sur la même journée
        If Weekday(dD2) = 1 Or sF1 = "x" Or sF2 = "x" Then  '---  dimanche ou férié
            hTot = 0
        Else
            hTot = 0
            hDeb = dD1 - Int(dD1)
            hFin = dD2 - Int(dD2)
            If Weekday(dD1) = 7 Then
                H_Fin = H_3                 '--- samedi: 14h00
            Else
                H_Fin = H_4                 '--- semaine: 19h00
            End If
            If hDeb < H_2 Then              '--- début avant 9h00
                If hFin > H_Fin Then
                    hTot = H_Fin - H_2     '--- fin après 19h (14h)
                Else
                    hTot = hFin - H_2      '--- fin avant 19h (14h)
                End If
            Else                                '--- début après 9h00
                If hFin < H_Fin Then
                    hTot = H_Fin - hDeb         '--- fin après 19h (14h)
                Else
                    hTot = hFin - hDeb          '--- fin avant 19h (14h)
                End If
            End If
        End If
    ElseIf Int(dD2 - 0.00001) > Int(dD1) Then
        '--- fin jour après début
        hTot = hTrf1(dD1, sF1, Int(dD2), sF1) + hTrf1(Int(dD2), sF2, dD2, sF2)
    Else
        hTot = "fin < début?"   '--- anomalie
    End If
    hTrf1 = hTot
End Function
 
'--- pas de fonction hTrf2
'--- heures au tarif 2 obtenu par soustraction des 3 autres au temps total

Bonne continuation.

13/06/2019, 12h04
Shaplow

2 pièce(s) jointe(s)

Merci de ton aide mais le code ne fonctionne pas pour toutes les horaires et je n'arrive pas à l'adapter :( C'est pas simple du tout

Je mets mon fichier ci joint en prenant soin de retirer les infos sensibles. J'ai également ajouter des notes pour mieux comprendre ce que je cherche

Pièce jointe 483175
13/06/2019, 15h52
EricDgn

1 pièce(s) jointe(s)

Bonjour,

Solution utilisant uniquement des fonctions particulières en VBA.
Temps de trajet et de préparation non pris en compte pour les calculs des valorisations.
Attention à quand même bien vérifier que les résultats donnés sont corrects pour toutes les situations!

Bonne continuation.
14/06/2019, 15h10
Shaplow

C'est parfait, j'ai finalement réussi, tout marche niquel je te remercie beaucoup ! ;) Passes une bonne journée