Forum |  HardWare.fr | News | Articles | PC | S'identifier | S'inscrire | Shop Recherche
1212 connectés 

  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

  calculer taux dispo

 
 


 Mot :   Pseudo :  
 
Bas de page
Auteur Sujet :

calculer taux dispo

n°2119643
debutVBA
Posté le 05-01-2012 à 11:02:39  profilanswer
 

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 :de 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 :
  1. Public colDateEnv, colDateClot, objJferies, ForWriting, nbmachines
  3. Sub calculPE()
  5. Const ForReading = 1, ForWriting = 2, ForAppending = 8
  8.              nbmachines = Application.InputBox(" Combien de machines a saisir", Type:=1)
  11. colDateEnv = 16
  12. colDateClot = 18
  14. Set objJferies = CreateObject("Scripting.Dictionary" )
  15. objJferies.CompareMode = vbTextCompare
  17. 'On ouvre le classeur
  18. Dim monClasseur As Workbook
  19. Set monClasseur = ActiveWorkbook
  21. monClasseur.Worksheets("JFériésExcep" ).Activate
  22. ' On lit la feuille des jours fériés
  23. For ligne = 2 To ActiveSheet.UsedRange.Rows.Count
  24.   objJferies.Add Cells(ligne, 1).Value, True
  26. Next
  29. 'on ouvre la feuille
  30. Dim maFeuille As Worksheet
  31. Set maFeuille = monClasseur.Worksheets("etat" )
  33. 'on active la feuille
  34. monClasseur.Worksheets("etat" ).Activate
  36. 'appel la fonction HeuresT
  37. Call HeuresT
  39. End Sub
  42. Function Work_Days(BegDate As Date, EndDate As Date, _
  43.                    Optional bAvecJFerie As Boolean = True) As Variant
  44.     Dim dt As Date
  46. On Error GoTo Work_Days_Error
  47.     If IsNull(BegDate) Or IsNull(EndDate) Then err.Raise vbObjectError + 1
  48.     If Not IsDate(BegDate) Or Not IsDate(EndDate) Then err.Raise vbObjectError + 2
  49.     If BegDate > EndDate Then err.Raise vbObjectError + 3
  51.     dt = BegDate
  52.     Work_Days = 0
  53.     While dt <= EndDate
  54.         If DatePart("w", dt, vbMonday) < 6 And Not objJferies.exists(dt) Then
  55.             Work_Days = Work_Days + 1
  56.         End If
  57.         dt = DateAdd("d", 1, dt)
  58.     Wend
  59.     Exit Function
  61. Work_Days_Error:
  62.     Select Case err.Number
  63.         Case vbObjectError + 1: Work_Days = "Les 2 dates sont obligatoires."
  64.         Case vbObjectError + 2: Work_Days = "Format de date incorrect."
  65.         Case vbObjectError + 3: Work_Days = "La date de fin doit être postérieure à la date de début."
  66.         Case Else: Work_Days = err.Description
  67.     End Select
  68. End Function
  71. Public Function HeuresT()
  73.     'les variables
  74.     Dim nbJoursComplets As Long
  75.     Dim nbHeuresAvant As Double
  76.     Dim nbHeuresApres As Double
  77.     Dim nbHeuresTotal As Double
  78.     Dim nbJours As Integer
  79.     Dim heuresRestantes As Double
  80.     Dim minutesRestantes As Integer
  81.     Dim leMois As String
  83.     'ici il faut saisir un mois entre 1 et 12 ce qui correspond de janvier à Decembre
  84.     leMois = Application.InputBox("Quel est le mois pour lequel vous souhaitez calculer les pénalités? (MM/AAAA)" )
  86.     If leMois = "" Or Len(leMois) <> 7 Then
  87.       Exit Function
  88.     End If
  91.     'le compteur va servir à compter le nombre d'interventions d'un mois donné
  92.     Dim compteur As Byte
  93.     compteur = 0
  95.     Dim PenaliteDeCeDossier As Long
  96.     PenaliteDeCeDossier = 0
  97.     Dim JoursSupplementaires As Long
  98.     JoursSupplementaires = 0
  99.     Dim SommePenaliteDuMois As Long
  100.     SommePenaliteDuMois = 0
  102.     StrPenalite = "Réparation" & vbTab & "Date d'envoi" & vbTab & vbTab & "Date clôture" & vbTab & vbTab & "Temps écoulé" & vbTab & vbTab & vbTab & "Pénalité (euros)"
  104.     'ici j'indique en dur qu'il y a uniquement les 10 lignes dans le fichier (A modifier)
  105.     For ligne = 2 To ActiveSheet.UsedRange.Rows.Count
  107.     ' on recupere le mois de la date indiquée dans la cellule
  108.         x = Right("0" & Month(Cells(ligne, colDateClot).Value), 2)
  109.         x = x & "/" & Year(Cells(ligne, colDateClot).Value)
  111.         If x = leMois Then
  112.                 'ici reste a verifier si la date est dans la liste des feries exceptionnels.
  113.                 'si c'est le cas ,on ne prend pas en compte cette date sinon,on peut continuer le calcul
  114.                 'condition qui servira a recuperer les cellules dont le mois correspond a celui dont on souhaite
  115.                 'y calculer ses pénalités
  117.             'servira pour le nombre d'intervention
  118.             compteur = compteur + 1
  120.             'Le nombre de jours ouvrés total entre date1 à minuit "du soir" et date2 à minuit "du matin" !
  121.             nbJoursComplets = Work_Days(DateValue(Cells(ligne, colDateEnv).Value), DateValue(Cells(ligne, colDateClot).Value), True) - 2
  123.            'Le nombre d'heures travaillées entre date1 et date1 à 18h
  124.            nbHeuresAvant = 0
  125.            If Hour(Cells(ligne, colDateEnv).Value) < 18 Then
  127.                If Hour(Cells(ligne, colDateEnv).Value) < 8 Then
  128.                    nbHeuresAvant = 10
  129.                Else
  130.                    nbHeuresAvant = 18 - (Hour(Cells(ligne, colDateEnv).Value) + Minute(Cells(ligne, colDateEnv).Value) / 60)
  131.                End If
  133.            End If
  135.            'Le nombre d'heures travaillées entre date2 à 8h et date2
  136.            If Hour(Cells(ligne, colDateClot).Value) >= 8 Then
  138.                 If Hour(Cells(ligne, colDateClot).Value) >= 18 Then
  139.                     nbHeuresApres = 10
  140.                 Else
  141.                     nbHeuresApres = Hour(Cells(ligne, colDateClot).Value) + Minute(Cells(ligne, colDateClot).Value) / 60 - 8
  142.                 End If
  144.             End If
  146.             nbHeuresTotal = 10 * nbJoursComplets + nbHeuresAvant + nbHeuresApres
  148.             'ici on recupere la partie entiere de nbHeuresTotal pour indiqué en nombre de jours
  149.             nbJours = Int(nbHeuresTotal / 10)
  150.             nbj = nbHeuresTotal / 10
  151.             heuresRestantes = nbHeuresTotal - nbJours * 10
  152.             minutesRestantes = (heuresRestantes - Int(heuresRestantes)) * 60
  154.             HeuresT = nbJours & " jours, " & Int(heuresRestantes) & " heures et " & minutesRestantes & " minutes"
  156.             PenaliteDeCeDossier = 0
  157.                    '  Indisponibilité > = à 1jours ou 10heures = 10€
  158.                     If nbJours = 1 Then
  159.                         PenaliteDeCeDossier = 10
  161.                     ' Indisponibilité entre 1 et 2 jours => 10€ +18 € = 28€
  162.                     ElseIf nbJours = 2 Then
  163.                         PenaliteDeCeDossier = 10 + 18
  165.                     ' Indisponibilité entre 2  et  3jours => 10€ +18€ + 25€  =53€
  166.                     ElseIf nbJours = 3 Then
  167.                         PenaliteDeCeDossier = 10 + 18 + 25
  169.                     ' Indisponibilité supérieur à 3jours  => 53€ + 25€/jour supplémentaire
  170.                     ElseIf nbJours >= 4 Then
  171.                         JoursSupplementaires = nbJours - 3 ' pour avoir le nombre de jours supplementaires
  172.                         PenaliteDeCeDossier = 10 + 18 + 25 + 25 * JoursSupplementaires
  174.                     End If
  176.             If PenaliteDeCeDossier <> 0 Then
  177.                 StrPenalite = StrPenalite & vbCrLf & Cells(ligne, 1).Value & vbTab & Cells(ligne, colDateEnv).Value & _
  178.                             vbTab & Cells(ligne, colDateEnv).Value & vbTab & HeuresT & vbTab & _
  179.                             Right("        " & PenaliteDeCeDossier, 7)
  180.             End If
  182.             PenaliteMois = PenaliteMois + PenaliteDeCeDossier
  183.         End If
  185. End If
  189.     Next
  193.              'VOICI LA PARTIE OU JE TENTE DE CALCULER LE TAUX DE DISPONIBILTE
  194.             'Pour le calcul taux de disponibilités
  195.              If (DateDiff("n", Cells(ligne, colDateClot).Value, "01/" & leMois) Or DateDiff("n", Cells(ligne, colDateEnv).Value, "31/" & leMois)) Then
  197.             MsgBox "rien du tout"
  199.             Else
  201.            date1 = Max(Cells(ligne, colDateEnv).Value, "01/" & leMois)
  203.            date2 = Min(Cells(ligne, colDateClot).Value, "31/" & leMois)
  206.                 'pour avoir le taux de disponibilités.
  207.                 x = nbjoursOuvre * nbmachines / 10
  210.               ' Taux de disponibilité du parc 98%
  211.                If tauxDisponibilteParc >= 98 Then
  212.                MsgBox "RIEN"
  213.                e
  214.                 ' entre 97 et 97.99% 1500€
  215.                ElseIf tauxDisponibilteParc >= 97 And tauxDisponibilteParc < 98 Then
  216.                MsgBox " cela coute 1500"
  218.                ' entre 96 et 96.99% 3000€
  219.                ElseIf tauxDisponibilteParc >= 96 And tauxDisponibilteParc < 97 Then
  220.                MsgBox "cela coute 3000 euros "
  222.                ElseIf tauxDisponibilteParc >= 0 And tauxDisponibilteParc < 96 Then
  223.                MsgBox "cela coute   4500€ "
  225.                End If
  230.     If compteur = 0 Then
  231.        MsgBox "Bizarre!: aucun dossier trouvé pour la date de clôture choisie: " & leMois
  232.     End If
  234.     StrPenalite = StrPenalite & vbCrLf & vbCrLf & "Pénalité totale pour " & compteur & " dossiers: " & PenaliteMois & " euros"
  235.     MsgBox StrPenalite
  238.     ForWriting = 2
  240.     'Pour creer le fichier texte
  241.     Set FSys = CreateObject("Scripting.FileSystemObject" )
  242.     Set MonFic = FSys.OpenTextFile("C:\Users\US12\Desktop\fichier.txt", ForWriting, True)
  243.     MonFic.WriteLine StrPenalite
  244.     MonFic.Close
  246.     End Function

mood
Publicité
Posté le 05-01-2012 à 11:02:39  profilanswer
 

n°2120126
astik89
Posté le 08-01-2012 à 14:43:43  profilanswer
 

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.


Aller à :
Ajouter une réponse
  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

  calculer taux dispo

 

Sujets relatifs
Calculer la différence entre deux dates (VBA)NET::FTP et taux de transfert
calculer une intégrale avec MatlabCalculer somme des champs d'un formulaire
Calculer distance d'un tracé GPSCalculer un pourcentage dans une requete
Calculer le temps passé depuis la dernière utilisation du PCComment calculer des statistiques à partir de boutons radio?
calculer le nombre de ligne d'une chainecalculer % php Mysql
Plus de sujets relatifs à : calculer taux dispo

Forum MesDiscussions.Net, Version 2010.2
(c) 2000-2011 Doctissimo
Page générée en 0.147 secondes

Copyright © 1997-2022 Hardware.fr SARL (Signaler un contenu illicite / Données personnelles) / Groupe LDLC / Shop HFR