insertion temps de cycle dans ma macro

Question

Bonjour a tous ;

je reviens vers vous car j'ai besoin de votre aide pour complété ma macro

c'est une macro qui simule la production dans une blanchisserie industriel

maintenant avec ma macro je simule les différentes étape de production sauf que maintenant il faut que d’introduit les temps de cycle au niveau de la phase de séchage :

dans la cellules AU vous aller voir que j'ai une affectation de familles dans les séchoir
dans l'exemple que j'ai dans l'image c'est la famille "chmal PM "

donc pour le cas de "chmal PM" par exemple ; il faut chercher son temps de cycle de séchoir dans la colonne AK et il faut qu'il reste pendant un temps de cycle séchoir de 0,0159722 min

svp aidez moi je sais pas comment introduire les temps dans ma macro

-voila le code qui gére la partis séchoir

'gestion des choix aléatoire des familles d'article dans le narlivté et affectation au séchoir
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim DerniereLigne, CptLigne, CptValeur As Integer
    CptValeur = 1

Recommence_la_boucle:
    If Mid(Target.Address, 2, 2) = "AE" Then
        If Target.Value <> "" Then
Recommence_la_boucl:
            If Application.WorksheetFunction.CountIf(Columns("AN:AN"), Target.Offset(-1).Value) > 0 Then


                Valeur = Int(Application.WorksheetFunction.CountIf(Columns("AN:AN"), Target.Offset(-1).Value) * Rnd) + 1
                DerniereLigne = Range("AN" & Rows.Count).End(xlUp).Row
                For CptLigne = 2 To DerniereLigne

                    If Range("AN" & CptLigne).Value = Target.Offset(-1).Value Then
                        If CptValeur = Valeur Then
                        If Range("AH" & CptLigne).Value - Range("AJ" & CptLigne).Value < 0 Then GoTo Recommence_la_boucl
                            Range("AQ" & CptLigne).Value = Range("AH" & CptLigne).Value - Range("AJ" & CptLigne).Value
                         
                            
                            Sechoir = Range("AL" & CptLigne).Value
                            UniteLavage = Range("AJ" & CptLigne).Value
                            Set celluletrouvee = Range("AU:AU").Find(Sechoir, lookat:=xlWhole)
                            
                            If celluletrouvee Is Nothing Then
                                MsgBox ("Séchoir introuvable")
                            Else
                             'rajouter les affectation au cellules si on a un cadencement plus que 6
                             
                                  Range("AU" & celluletrouvee.Row + 1).Value = Range("AG" & CptLigne).Value
                     
                                  Application.Wait Time + TimeSerial(0, 0, 1)
                                  Range("AU" & celluletrouvee.Row + 1).Value = ""
                                  Range("AE3").Value = Range("AD3").Value
                                   Range("AE5").Value = Range("AD5").Value
                                    Range("AE7").Value = Range("AD7").Value
                                     Range("AE9").Value = Range("AD9").Value
                                      Range("AE11").Value = Range("AD11").Value
                                      Range("AE13").Value = Range("AD13").Value
                             
                              
                            End If
                             GoTo Recommence_la_boucle
                            'GoTo FinJob
                        Else
                            CptValeur = CptValeur + 1
                        End If
                    End If
                Next CptLigne
            Else
                MsgBox ("Pas de correspondance dans le tableau AG:AS")
            End If
        End If
    End If
FinJob:
End Sub

merci

voila le fichier excel
https://www.cjoint.com/c/FGii1EfOWWh
cordialement

Afficher la suite

Frenchie83 · Answer

Bonjour
Si j'ai bien compris

'gestion des choix aléatoire des familles d'article dans le narlivté et affectation au séchoir
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim DerniereLigne, CptLigne, CptValeur As Integer
    CptValeur = 1

Recommence_la_boucle:
    If Mid(Target.Address, 2, 2) = "AE" Then
        If Target.Value <> "" Then
Recommence_la_boucl:
            If Application.WorksheetFunction.CountIf(Columns("AN:AN"), Target.Offset(-1).Value) > 0 Then
                Valeur = Int(Application.WorksheetFunction.CountIf(Columns("AN:AN"), Target.Offset(-1).Value) * Rnd) + 1
                DerniereLigne = Range("AN" & Rows.Count).End(xlUp).Row
                For CptLigne = 2 To DerniereLigne
                    If Range("AN" & CptLigne).Value = Target.Offset(-1).Value Then
                        If CptValeur = Valeur Then
                        If Range("AH" & CptLigne).Value - Range("AJ" & CptLigne).Value < 0 Then GoTo Recommence_la_boucl
                            Range("AQ" & CptLigne).Value = Range("AH" & CptLigne).Value - Range("AJ" & CptLigne).Value
                            Sechoir = Range("AL" & CptLigne).Value
                            UniteLavage = Range("AJ" & CptLigne).Value
                            Set celluletrouvee = Range("AU:AU").Find(Sechoir, lookat:=xlWhole)
                            If celluletrouvee Is Nothing Then
                                MsgBox ("Séchoir introuvable")
                            Else
                               'rajouter les affectation au cellules si on a un cadencement plus que 6
                                Range("AU" & celluletrouvee.Row + 1).Value = Range("AG" & CptLigne).Value
                                '********************************************************************************************************************
                                Range("AM" & CptLigne).Interior.Color = 65280 'fond vert
                                Application.Wait Time + TimeSerial(0, 0, 1)
                                Range("AU" & celluletrouvee.Row + 1).Value = ""
                                Range("AE3").Value = Range("AD3").Value
                                Range("AE5").Value = Range("AD5").Value
                                Range("AE7").Value = Range("AD7").Value
                                Range("AE9").Value = Range("AD9").Value
                                Range("AE11").Value = Range("AD11").Value
                                Range("AE13").Value = Range("AD13").Value
                                '********************************************************************************************************************
                                Range("AM2:AM40").Interior.Color = 16777164 'fond bleu
                            End If
                             GoTo Recommence_la_boucle
                            'GoTo FinJob
                        Else
                            CptValeur = CptValeur + 1
                        End If
                    End If
                Next CptLigne
            Else
                MsgBox ("Pas de correspondance dans le tableau AG:AS")
            End If
        End If
    End If
FinJob:
End Sub

et rajoutez aussi cette ligne à la fin de la macro "Tunel"

 Range("AM2:AM40").Interior.Color = 16777164 'fond bleu

Cdlt

Barahaoua · Answer

Merci Frenchie mais malheuresement c'est oas exactement ce que je veux je vu que ta fait une macro qui colorie la colonne AM quand l'article qui correspond a cette colonne est séléctionner 

moi le but c'est pas la colorier mais enfaite c'est que l'orsque la familles d'article qui lui correspond est revoyer vers le séchoir ; il faut qu'il reste dans le séchoir prendant son temps de cycle qui est positionné dans la colonne AM 

j'espére que ta compris 

merci beaucoup

Frenchie83 · Answer

Bonjour
Si j'ai bien compris, il faut que le programme s'arrête le temps du séchage (valeur en colonne AM) puis passe au suivant, ça oscille entre 0 et 27minutes.

https://www.cjoint.com/c/FGpiU1zGJNl
J'ai laissé le marquage en vert, histoire de se repérer dans le tableau.
A tester
CDLT

Insertion temps de cycle dans ma macro

3 réponses

Votre réponse

Discussions similaires

Newsletters