automatiser un fichier de production

[Sabrina_95]

Bonjour à tous les fans d’excel, vba et autres…
J’ai besoin de votre aide…
Je souhaite étudier la productivité dans une salle d’employés qui roulent des nems à la main. J’ai déjà pas mal d’informations dont les références théoriques (vitesse moyenne en fonction du nombre de rouleuses). EX : 33 min pour rouler une échelle (700 ROULEAUX). Je pensais avoir vraiment bien calculer la productivité en utilisant un peu le pifomètre en me disant que sur une recette il y avait à peu près 6 rouleuses et que la recette d’après y en avait environ 5 car une était partie en pause…c’est vraiment « de l’à peu près » mais moi je veux quelque chose de précis et qui pourrait être utilisé par les employés sans que j’ai à décortiquer toutes les feuilles de production chaque jour.
Voici en pièces jointes le document sur lequel je souhaite travailler. Le tableau situé au-dessus de la feuille est la fiche que les employés ont en production :
A, B, C, D... sont les noms des employés. Ils indiquent sur cette feuille l’heure à laquelle ils commencent à rouler et l’heure à laquelle ils cessent de rouler.
Comme vous pouvez le voir, il y a un roulement d’employés assez important. Je souhaite connaitre le nombre de rouleuse moyen par recette (le tableau correspond aux horaires d’une recette).
De plus, je souhaite automatiser l’ensemble. C'est-à-dire que lorsque chaque employé inscrit ces horaires dans le tableau du haut de la feuille, je souhaite que les informations s’inscrivent dans le tableau du dessous qui correspond à un planning par employé.
Ensuite, pour que ca soit plus visuel j’aurais besoin que chaque tranche horaire soit automatiquement surlignée en bleu automatiquement (comme vous pouvez le voir je l’ai fait manuellement).
Ainsi, en tenant compte des entrées et sortie des employés j’aurais besoin de connaître le nombre de rouleuse moyen précis qu’il y a eu pour une recette. Si par exemple, elles sont 6 rouleuses et qu’une rouleuse s’absente 30 min, j’ai besoin de connaître le nombre de main-d’œuvre réel que j’ai eu…Et ceci automatiquement et sans avoir besoin de refaire le calcul à la main et à décortiquer les feuilles de production.
J’espère avoir été le plus clair possible et si quelqu’un pouvait m’aider, ca serait juste super…
Merci d’avance pour votre aide, c’est un vrai casse tête chinois…

 

[Sabrina_95]

Re : automatiser un fichier de production

J'ai oublié, voici mon fichier en pièces jointes.

 

[david84]

Re : automatiser un fichier de production

Re
Tu avais oublié le code présent dans "feuille_prod" (la procédure qui lance l’évènement Change).
J'ai modifié la macro en partant du principe que le dernier fichier correspondait exactement à ton fichier original, ai placé le code dans le module de "feuille_prod" et ai supprimé le module initial.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Heure, Nom, Pl1, Pl2(), PlH(), i&, j&, k&, Deb, Fin, DerColPl1 As Byte
Application.ScreenUpdating = False
With Sheets("feuille_prod")
    Nom = .Range("A4", .[A4].End(xlDown))
    DerColPl1 = Application.Match("Heure", .Range("B3", .[B3].End(xlToRight)), 0) - 1
    Set Pl1 = .[B4].Resize(UBound(Nom), DerColPl1)
    If Not Intersect(Target, Pl1) Is Nothing And Target.Count = 1 Then
        Set Heure = .Range("A27", .[A27].End(xlDown))
        For i = 1 To Heure.Rows.Count
            ReDim Preserve PlH(1 To Heure.Rows.Count)
            PlH(i) = Round(Heure(i), 6)
        Next i
        
        ReDim Pl2(1 To Heure.Rows.Count, 1 To UBound(Nom))
        For i = 1 To UBound(Nom)
            For j = 1 To Pl1.Columns.Count Step 2
                On Error Resume Next
                Deb = Application.WorksheetFunction.Match(Application.WorksheetFunction.Round(Pl1(i, j), 6), PlH, 0)
                On Error Resume Next
                Fin = Application.WorksheetFunction.Match(Application.WorksheetFunction.Round(Pl1(i, j + 1), 6), PlH, 0)
                If Deb = 0 Or Fin = 0 Or Fin <= Deb Then Exit For
                Pl2(Deb, i) = "Début"
                k = 1
                While Deb + k < Fin
                    Pl2(Deb + k, i) = 1: k = k + 1
                Wend
                Pl2(Deb + k, i) = "Fin"
                Deb = 0: Fin = 0
            Next j
            Deb = 0: Fin = 0
            
        Next i
        .[B26].Resize(UBound(Pl2) + 1, UBound(Pl2, 2)).ClearContents
        .[B26].Resize(, UBound(Nom)) = Application.Transpose(Nom)
        .[B27].Resize(UBound(Pl2), UBound(Pl2, 2)) = Pl2
    End If
End With
Application.ScreenUpdating = True
End Sub

Toute modification de la plage B4:M23 déclenche la procédure évènementielle.
Teste de ton côté.
A+

 

[Sabrina_95]

Re : automatiser un fichier de production

Re,
merci beaucoup, j'ai testé sur mon fichier et ca fonctionne très bien. Je trouve cependant la macro un peu longue. En effet, dès que je veux insérer un horaire dans la plage B4 à M23 il y a un temps d'attente.
Je vois que tu as ajouté Application.ScreenUpdating = False, y a-t-il une autre facon d'accélérer la macro?
Merci

 

[david84]

Re : automatiser un fichier de production

Re
A combien évalues-tu ce temps d'attente ?
Sur le fichier placé sur le forum, c'est pourtant rapide.
A mon avis, c'est peut-être les calculs placés dans la feuille de calcul qui ralentissent la procédure.
Test le code suivant tel quel puis après avoir enlevé les "'" placés devantApplication.Calculation en début et fin de code. Fait également le test en intervertissant Application.Calculation et Application.EnableEvents (en début et fin de code), compare le résultat et tiens-nous au courant :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Heure As Range, Nom, Pl1 As Range, Pl2(), PlH(), i&, j&, k&, Deb&, Fin&, DerColPl1 As Byte
Application.ScreenUpdating = False
'Application.Calculation = xlCalculationManual
With Sheets("feuille_prod")
    Nom = .Range("A4", .[A4].End(xlDown))
    DerColPl1 = Application.Match("Heure", .Range("B3", .[B3].End(xlToRight)), 0) - 1
    Set Pl1 = .[B4].Resize(UBound(Nom), DerColPl1)
    If Not Intersect(Target, Pl1) Is Nothing And Target.Count = 1 Then
        Set Heure = .Range("A27", .[A27].End(xlDown))
        For i = 1 To Heure.Rows.Count
            ReDim Preserve PlH(1 To Heure.Rows.Count)
            PlH(i) = Round(Heure(i), 6)
        Next i
        
        ReDim Pl2(1 To Heure.Rows.Count, 1 To UBound(Nom))
        For i = 1 To UBound(Nom)
            For j = 1 To Pl1.Columns.Count Step 2
                On Error Resume Next
                Deb = Application.WorksheetFunction.Match(Application.WorksheetFunction.Round(Pl1(i, j), 6), PlH, 0)
                On Error Resume Next
                Fin = Application.WorksheetFunction.Match(Application.WorksheetFunction.Round(Pl1(i, j + 1), 6), PlH, 0)
                If Deb = 0 Or Fin = 0 Or Fin <= Deb Then Exit For
                Pl2(Deb, i) = "Début"
                k = 1
                While Deb + k < Fin
                    Pl2(Deb + k, i) = 1: k = k + 1
                Wend
                Pl2(Deb + k, i) = "Fin"
                Deb = 0: Fin = 0
            Next j
            Deb = 0: Fin = 0
            
        Next i
        .[B26].Resize(UBound(Pl2) + 1, UBound(Pl2, 2)).ClearContents
        .[B26].Resize(, UBound(Nom)) = Application.Transpose(Nom)
        .[B27].Resize(UBound(Pl2), UBound(Pl2, 2)) = Pl2
    End If
End With
'Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

A+

 

[Sabrina_95]

Re : automatiser un fichier de production

Avec la pièce jointe c'est mieux