Insertion temps de cycle dans ma macro
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
3 réponses
-
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 -
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 -
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
