calculer taux dispo

Marsh Posté le 05-01-2012 à 11:02:39

Bonjour à tous et toutes ,

Donc je suis en train d'essayer de terminer mon jolie programme mais je suis vraiment coincé sur le dernier code à effectuer donc je m'explique

il faut que je calcule le taux de diponibilité du parc ,
le nombre de machines sera donc une saisie écran,l'utilisateur donnera donc un nombre de machines

les contraintes sont aussi qu'une journée fait 10 heures e 8heures à 18heures
Les week ends et jours féries ne sont pas compté également.

*Taux de disponibilité du parc 98%
les pénalités associés sont entre 97 et 97.99% 2000€
entre 96 et 96.99% 4250€
entre 0 et 95.99% 6890€

*Plafond pénalités annuelles 21000€

le code associé :

Code :

Public colDateEnv, colDateClot, objJferies, ForWriting, nbmachines
Sub calculPE()
Const ForReading = 1, ForWriting = 2, ForAppending = 8
nbmachines = Application.InputBox(" Combien de machines a saisir", Type:=1)
colDateEnv = 16
colDateClot = 18
Set objJferies = CreateObject("Scripting.Dictionary" )
objJferies.CompareMode = vbTextCompare
'On ouvre le classeur
Dim monClasseur As Workbook
Set monClasseur = ActiveWorkbook
monClasseur.Worksheets("JFériésExcep" ).Activate
' On lit la feuille des jours fériés
For ligne = 2 To ActiveSheet.UsedRange.Rows.Count
objJferies.Add Cells(ligne, 1).Value, True
Next
'on ouvre la feuille
Dim maFeuille As Worksheet
Set maFeuille = monClasseur.Worksheets("etat" )
'on active la feuille
monClasseur.Worksheets("etat" ).Activate
'appel la fonction HeuresT
Call HeuresT
End Sub
Function Work_Days(BegDate As Date, EndDate As Date, _
Optional bAvecJFerie As Boolean = True) As Variant
Dim dt As Date
On Error GoTo Work_Days_Error
If IsNull(BegDate) Or IsNull(EndDate) Then err.Raise vbObjectError + 1
If Not IsDate(BegDate) Or Not IsDate(EndDate) Then err.Raise vbObjectError + 2
If BegDate > EndDate Then err.Raise vbObjectError + 3
dt = BegDate
Work_Days = 0
While dt <= EndDate
If DatePart("w", dt, vbMonday) < 6 And Not objJferies.exists(dt) Then
Work_Days = Work_Days + 1
End If
dt = DateAdd("d", 1, dt)
Wend
Exit Function
Work_Days_Error:
Select Case err.Number
Case vbObjectError + 1: Work_Days = "Les 2 dates sont obligatoires."
Case vbObjectError + 2: Work_Days = "Format de date incorrect."
Case vbObjectError + 3: Work_Days = "La date de fin doit être postérieure à la date de début."
Case Else: Work_Days = err.Description
End Select
End Function
Public Function HeuresT()
'les variables
Dim nbJoursComplets As Long
Dim nbHeuresAvant As Double
Dim nbHeuresApres As Double
Dim nbHeuresTotal As Double
Dim nbJours As Integer
Dim heuresRestantes As Double
Dim minutesRestantes As Integer
Dim leMois As String
'ici il faut saisir un mois entre 1 et 12 ce qui correspond de janvier à Decembre
leMois = Application.InputBox("Quel est le mois pour lequel vous souhaitez calculer les pénalités? (MM/AAAA)" )
If leMois = "" Or Len(leMois) <> 7 Then
Exit Function
End If
'le compteur va servir à compter le nombre d'interventions d'un mois donné
Dim compteur As Byte
compteur = 0
Dim PenaliteDeCeDossier As Long
PenaliteDeCeDossier = 0
Dim JoursSupplementaires As Long
JoursSupplementaires = 0
Dim SommePenaliteDuMois As Long
SommePenaliteDuMois = 0
StrPenalite = "Réparation" & vbTab & "Date d'envoi" & vbTab & vbTab & "Date clôture" & vbTab & vbTab & "Temps écoulé" & vbTab & vbTab & vbTab & "Pénalité (euros)"
'ici j'indique en dur qu'il y a uniquement les 10 lignes dans le fichier (A modifier)
For ligne = 2 To ActiveSheet.UsedRange.Rows.Count
' on recupere le mois de la date indiquée dans la cellule
x = Right("0" & Month(Cells(ligne, colDateClot).Value), 2)
x = x & "/" & Year(Cells(ligne, colDateClot).Value)
If x = leMois Then
'ici reste a verifier si la date est dans la liste des feries exceptionnels.
'si c'est le cas ,on ne prend pas en compte cette date sinon,on peut continuer le calcul
'condition qui servira a recuperer les cellules dont le mois correspond a celui dont on souhaite
'y calculer ses pénalités
'servira pour le nombre d'intervention
compteur = compteur + 1
'Le nombre de jours ouvrés total entre date1 à minuit "du soir" et date2 à minuit "du matin" !
nbJoursComplets = Work_Days(DateValue(Cells(ligne, colDateEnv).Value), DateValue(Cells(ligne, colDateClot).Value), True) - 2
'Le nombre d'heures travaillées entre date1 et date1 à 18h
nbHeuresAvant = 0
If Hour(Cells(ligne, colDateEnv).Value) < 18 Then
If Hour(Cells(ligne, colDateEnv).Value) < 8 Then
nbHeuresAvant = 10
Else
nbHeuresAvant = 18 - (Hour(Cells(ligne, colDateEnv).Value) + Minute(Cells(ligne, colDateEnv).Value) / 60)
End If
End If
'Le nombre d'heures travaillées entre date2 à 8h et date2
If Hour(Cells(ligne, colDateClot).Value) >= 8 Then
If Hour(Cells(ligne, colDateClot).Value) >= 18 Then
nbHeuresApres = 10
Else
nbHeuresApres = Hour(Cells(ligne, colDateClot).Value) + Minute(Cells(ligne, colDateClot).Value) / 60 - 8
End If
End If
nbHeuresTotal = 10 * nbJoursComplets + nbHeuresAvant + nbHeuresApres
'ici on recupere la partie entiere de nbHeuresTotal pour indiqué en nombre de jours
nbJours = Int(nbHeuresTotal / 10)
nbj = nbHeuresTotal / 10
heuresRestantes = nbHeuresTotal - nbJours * 10
minutesRestantes = (heuresRestantes - Int(heuresRestantes)) * 60
HeuresT = nbJours & " jours, " & Int(heuresRestantes) & " heures et " & minutesRestantes & " minutes"
PenaliteDeCeDossier = 0
' Indisponibilité > = à 1jours ou 10heures = 10€
If nbJours = 1 Then
PenaliteDeCeDossier = 10
' Indisponibilité entre 1 et 2 jours => 10€ +18 € = 28€
ElseIf nbJours = 2 Then
PenaliteDeCeDossier = 10 + 18
' Indisponibilité entre 2 et 3jours => 10€ +18€ + 25€ =53€
ElseIf nbJours = 3 Then
PenaliteDeCeDossier = 10 + 18 + 25
' Indisponibilité supérieur à 3jours => 53€ + 25€/jour supplémentaire
ElseIf nbJours >= 4 Then
JoursSupplementaires = nbJours - 3 ' pour avoir le nombre de jours supplementaires
PenaliteDeCeDossier = 10 + 18 + 25 + 25 * JoursSupplementaires
End If
If PenaliteDeCeDossier <> 0 Then
StrPenalite = StrPenalite & vbCrLf & Cells(ligne, 1).Value & vbTab & Cells(ligne, colDateEnv).Value & _
vbTab & Cells(ligne, colDateEnv).Value & vbTab & HeuresT & vbTab & _
Right(" " & PenaliteDeCeDossier, 7)
End If
PenaliteMois = PenaliteMois + PenaliteDeCeDossier
End If
End If
Next
'VOICI LA PARTIE OU JE TENTE DE CALCULER LE TAUX DE DISPONIBILTE
'Pour le calcul taux de disponibilités
If (DateDiff("n", Cells(ligne, colDateClot).Value, "01/" & leMois) Or DateDiff("n", Cells(ligne, colDateEnv).Value, "31/" & leMois)) Then
MsgBox "rien du tout"
Else
date1 = Max(Cells(ligne, colDateEnv).Value, "01/" & leMois)
date2 = Min(Cells(ligne, colDateClot).Value, "31/" & leMois)
'pour avoir le taux de disponibilités.
x = nbjoursOuvre * nbmachines / 10
' Taux de disponibilité du parc 98%
If tauxDisponibilteParc >= 98 Then
MsgBox "RIEN"
e
' entre 97 et 97.99% 1500€
ElseIf tauxDisponibilteParc >= 97 And tauxDisponibilteParc < 98 Then
MsgBox " cela coute 1500"
' entre 96 et 96.99% 3000€
ElseIf tauxDisponibilteParc >= 96 And tauxDisponibilteParc < 97 Then
MsgBox "cela coute 3000 euros "
ElseIf tauxDisponibilteParc >= 0 And tauxDisponibilteParc < 96 Then
MsgBox "cela coute 4500€ "
End If
If compteur = 0 Then
MsgBox "Bizarre!: aucun dossier trouvé pour la date de clôture choisie: " & leMois
End If
StrPenalite = StrPenalite & vbCrLf & vbCrLf & "Pénalité totale pour " & compteur & " dossiers: " & PenaliteMois & " euros"
MsgBox StrPenalite
ForWriting = 2
'Pour creer le fichier texte
Set FSys = CreateObject("Scripting.FileSystemObject" )
Set MonFic = FSys.OpenTextFile("C:\Users\US12\Desktop\fichier.txt", ForWriting, True)
MonFic.WriteLine StrPenalite
MonFic.Close
End Function

Marsh Posté le 05-01-2012 à 11:02:39

Marsh Posté le 08-01-2012 à 14:43:43

Si tu veux une réponse:

explique ton problème correctement. J'ai à peu près compris ce que tu voulais faire, mais je ne vois pas ton problème.
met juste l'extrait de code où tu as un problème.

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed

Name *

Email *

URL

Message *