Problème dans une formule

**fabien70190** · 15/09/2016, 11h18

Bonjour à tous,

Voila je suis en train de réaliser un planning de production avec diverses informations, que je rentre manuellement dans excel (nombres de pièces à produire, temps de productions par pièces, date et heure de commencement).
Je ne connais pas grand chose en VBA, mais je pense pas être très loin de mon objectif. Je précise que j'ai réalisé le tableau, avec une personne qui si connait mieux que moi en VBA, mais qui m'a abandonné...

Mon but : En fonction des données rentré manuellement, j'aimerais que mon tableau me calcul la date et heure de fin, sachant que l'entreprise travail 2 x 8 (39h / semaine).
Mon problème : Sur la première ligne mon calcul se fait bien, par contre sur la deuxième ligne le calcul donne un résultat faux.

Je sais qu'il ne faut pas mettre de fichier sur le forum, donc je joint le code ci dessous, mais je pense pas que ça soit très compréhensible donc dans le doute je mets aussi le fichier.

Le code qui pose problème :

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
'Ecriture du résultat
            Range("I" & ln) = Cells(4, col - 1).Value + (5 + Cells(7, col - 1).Value) / 24
 
            For k = 1 To 5
                g = Choose(k, 5, 22, 39, 56, 73) 'numéro de colonne de la feuille gantt de E (5) à BU (73)
                If Int(fG.Cells(1, g)) = Int(Range("H" & ln)) Then
                    colD = g + Hour(Range("H" & ln)) - 5
                End If
 
                If Int(fG.Cells(1, g)) = Int(Range("I" & ln)) Then
                    colF = g + Hour(Range("I" & ln)) - 5
                End If
            Next k
            fG.Range(fG.Cells(ln, colD), fG.Cells(ln, colF)).Interior.Color = RGB(0, 0, 255)
 
        End If
suivant:
    Next ln
 
    Application.EnableEvents = True
End Sub

Le code au complet :

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
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
133
134
135
136
137
138
139
140
141
142
143
Option Explicit
 
Dim derLn, ln, j, col, duree, hdeb, hr
Dim An, u_And, z, dateJ, tDate
Dim n, a, b, c, d, e, r, rv
Dim fG, g, k, cln, colD, colF
 
Sub DateDeFin()
 
    'Call JoursFermeture
    Application.EnableEvents = False
    derLn = Range("H" & Rows.Count).End(xlUp).Row
    Range("I5:I" & derLn).ClearContents
    Set fG = Sheets("Gantt")
 
    'initialisation de la feuille Gantt
    fG.Range("E5:CI13,E16:CI24,E27:CI35,E38:CI46,E49:CI57").Interior.Color = xlNone
    fG.Range("A4:CI4,E15:CI15,E26:CI26,E37:CI37,E48:CI48").Interior.Color = RGB(165, 165, 165)
 
    For ln = 5 To derLn
        'On initialise (efface) la ligne 7 du tableau de travail
        Range("L7:Y7").ClearContents
 
        'col = 12    'colonne du premier jour de la semaine
        If IsDate(Range("H" & ln).Value) And Range("H" & ln).Value <> "" And Range("F" & ln).Value <> "" Then
            'On recherche dans le tableau annexe la date de début
            For col = 12 To 25
                If Cells(4, col).Value = Int(Range("H" & ln)) Then
                    Exit For
                End If
            Next col
 
            'On passe toutes les colonnes du tableau de travail jusqu'à épuisement des
            'heures à reporter
            r = Range("F" & ln)   'durée à reporter
            Do While r > 0
                If Cells(7, col).Value + r + 5 < Cells(6, col).Value Then
                    Cells(7, col).Value = Cells(7, col).Value + r
                    'Ecriture du résultat
                    Range("I" & ln) = Cells(4, col).Value + (5 + Cells(7, col).Value) / 24
 
                    'Gantt
                    For k = 1 To 5
                        g = Choose(k, 5, 22, 39, 56, 73) 'numéro de colonne dans tableau gantt (5, 22, 39, 56, 73)
                        If Int(fG.Cells(1, g)) = Int(Range("H" & ln)) Then
                            colD = g + Hour(Range("H" & ln)) - 5 'début de la couleur bleu dans gantt
                        End If
 
                        If Int(fG.Cells(1, g)) = Int(Range("I" & ln)) Then
                            colF = g + Hour(Range("I" & ln)) - 5 'fin de la couleur bleu dans gantt
                        End If
                    Next k
                    fG.Range(fG.Cells(ln, colD), fG.Cells(ln, colF)).Interior.Color = RGB(0, 0, 255)
 
 
 
                    GoTo suivant
                Else
                    r = r + Cells(7, col).Value
                    Cells(7, col).Value = Application.Min(Cells(6, col) - 5, r)
                    r = r - Cells(7, col)
                End If
 
                col = col + 1
                Call VerifJF    'il faut regarder si la nouvelle colonne est un jour férié
 
                If col > 25 Then    '25 parce qu'on a limité le tableau à la colonne 25
                    Range("I" & ln).Value = "Après le " & Int(Range("H" & ln))
 
 
                    fG.Range(fG.Cells(ln - 1, colD), fG.Cells(ln - 1, 87)).Interior.Color = RGB(0, 0, 255)
 
 
 
 
                    GoTo suivant
                End If
            Loop
            'Ecriture du résultat
            Range("I" & ln) = Cells(4, col - 1).Value + (5 + Cells(7, col - 1).Value) / 24
 
            For k = 1 To 5
                g = Choose(k, 5, 22, 39, 56, 73) 'numéro de colonne de la feuille gantt de E (5) à BU (73)
                If Int(fG.Cells(1, g)) = Int(Range("H" & ln)) Then
                    colD = g + Hour(Range("H" & ln)) - 5
                End If
 
                If Int(fG.Cells(1, g)) = Int(Range("I" & ln)) Then
                    colF = g + Hour(Range("I" & ln)) - 5
                End If
            Next k
            fG.Range(fG.Cells(ln, colD), fG.Cells(ln, colF)).Interior.Color = RGB(0, 0, 255)
 
        End If
suivant:
    Next ln
 
    Application.EnableEvents = True
End Sub
 
Sub VerifJF()
    'On vérifie que le jour de la ligne (ln) étudiée n'est pas férié
    While Cells(6, col).Value = 0 And col <= 25
        col = col + 1 'on passe à la colonne suivante si le jour est férié
    Wend
End Sub
 
Sub JoursFermeture()
 
    An = Cells(1, 5).Value
    Application.Goto Reference:="Jours_de_fermeture"
    u_And = Year(Selection.Offset(1, 0).Value)
    If An <> u_And Then 'Mise à jour des dates de fermeture dans le tableau des données
            Selection.Offset(1, 0).Value = Pâques(An)
            'For z = 5 To 30 'Lignes des congés été, hiver et jours feriés
                'dateJ = Selection.Offset(z, 0).Value
                'Selection.Offset(z, 0).Value = Day(dateJ) & "/" & Month(dateJ) & "/" & Year(Date)
            'Next z
    End If
End Sub
 
Function Pâques(An)
 
    n = An - 1900
    a = n Mod 19
    b = Int((7 * a + 1) / 19)
    c = (11 * a - b + 4) Mod 29
    d = Int(n / 4)
    e = (n - c + d + 31) Mod 7
    If (25 - c - e) > 0 Then
        Pâques = DateSerial(An, 4, 25 - c - e)
    Else
        Pâques = DateSerial(An, 3, 56 - c - e)
    End If
End Function
 
 
 
 
 
Sub Evenement()
    Application.EnableEvents = True
End Sub

Merci de votre aide précieuse.

Problème dans une formule

Macros et VBA Excel

Mode arborescent

Discussions similaires

Partager

Partager