Rajouter une condition de vérification a ma macro
B
Bonjour s'il vous plait les amis j'ai besoin de votre aide
je voulais vous mettre un fichier excel met malheuresement il est trop lourd j'ai pas pu le mettre en piéces jointes
voila une macro qui fonctionne très bien sauf comme vous pouvez le voir sur l'image sauf qu'il ne suit pas l'ordonnacement ; je veux lui rajouté une condition de vérification avant le lancement de chaque code produit qu'il verifie est ce que elle correspond a l'ordonnancement .
vous pouvez voir l'idée de ce que je veux faire a travair le fichier excel que je vais vous mettre en piéce jointe mais la macro ci dessous elle correspond pas a ce fichier .
Option Explicit
Option Base 1 '--- la numérotation des tableaux (arrays) commence à 1
'--- 99 familles de produit
Dim FPcode(99) As String '--- tous les codes DOIVENT se terminer par 2 chiffres 01, 02, ... 99
Dim FPnom(99) As String
Dim FPSechTyp(99) As String
Dim FPSechTemps(99) As Single
Dim FPCalTyp(99) As String
Dim FPCalTemps(99) As Single
'---
Dim kCSF As Long '--- n° colonne Sortie Finale
Dim kRSF As Long '--- n° ligne Sortie Finale
Dim kCt As Long '--- n° colonne tunnels
Dim kCs As Long '--- n° colonne séchoirs
Dim kCc As Long '--- n° colonne calandreuses
Dim kRFP As Long '--- n° ligne famille produit
Dim kRtFin As Long '--- n° dernière ligne tunnel
Dim kRsFin As Long '--- n° dernière ligne séchoirs
Dim kRcFin As Long '--- n° dernière ligne calandres
Dim nFP As Long '--- nombre de produits à traiter
Dim nSF As Long '--- nombre de produits en sortie finale
Private Sub InitialiserFP() '--- FP Famile Produit
Dim wshD As Worksheet, kR As Long, i As Long, t As Variant
Set wshD = ActiveWorkbook.Worksheets("Donnees")
kR = 2 '--- commencer ligne 2
With wshD
While Len(.Cells(kR, 1)) > 0
i = Val(Right(.Cells(kR, 11), 2))
FPnom(i) = .Cells(kR, 1) '--- nom
FPcode(i) = .Cells(kR, 1) '--- code (1 au lieu de 11)
FPSechTyp(i) = .Cells(kR, 6) '--- type séchoir
t = .Cells(kR, 7)
t = Hour(t) * 24 + Minute(t)
FPSechTemps(i) = t / 1440 '--- cycle séchoir (conversion heures en secondes)
FPCalTyp(i) = .Cells(kR, 8) '--- type calandre
FPCalTemps(i) = FPSechTemps(i) '--- cycle calandre = cycle sechoir --- à modifier
kR = kR + 1
'Debug.Print FPcode(i), FPSechTemps(i)
Wend
End With
Set wshD = Nothing
End Sub
Sub Simulation()
Dim dH As String, hFin As Single
'--- initialisatoon
InitialiserFP
nFP = 0
nSF = 0
kCt = [C1].Column '--- colonne Machine Tunnel
kCs = [K1].Column '--- colonne Machine Séchoirs
kCc = [S1].Column '--- colonne Machine Calandres
kCSF = [AA1].Column '--- colonne Sortie Finale
kRcFin = Range("S" & Rows.Count).End(xlUp).Row '--- dernière ligne colonne Z, sorties caladreuses
kRsFin = Range("K" & Rows.Count).End(xlUp).Row '--- dernière ligne colonne R, sorties séchoirs
kRtFin = Range("C" & Rows.Count).End(xlUp).Row '--- dernière ligne colonne J, sorties tunnels
kRSF = 2 '--- première ligne Sortie Finale
kRFP = 21 '--- première ligne famille produit
[B8] = [B6] + 1 '--- 1 jour ======================= simulation sur 1 jour (24 heures)
hFin = [B8] '--- heure fin
dH = 1 / 24 / 60 '--- 1 minute --- pas de temps de la simulation
'--- 1 minute = 1 jour / 24 heures / 60 minutes
[B8] = [B6] '--- B6 heure actuelle = B5 heure départ
'--- boucle de simulation
While [B8] <= hFin
SimulerProduit
[B8] = [B8] + dH
'If MsgBox("Simuler minute " & Format([B8], "hh\h mm\'"), vbYesNo + vbDefaultButton1, "Continuer") = vbNo Then Exit Sub
DoEvents
If nSF = nFP Then
MsgBox "Tous les produits ont été traités"
Exit Sub
End If
Wend
End Sub
Sub SimulerProduit()
Dim kR As Long, hMax As Single, kC As Long
'--- sortir les produits traités de leurs machines
'--- sorties calandreuses
For kR = 4 To kRcFin Step 6 '--- 4: première ligne produit en première calandre
If Cells(kR, kCc + 6) = "" Then
'--- rien, machine vide
Else
If [B8] >= Cells(kR + 4, kCc + 6) Then '--- si l'heure est atteinte
'--- mettre le produit en sortie, en déplaçant toute la file vers la droite
Range(Cells(kR, kCc + 1), Cells(kR + 4, kCc + 6)).Copy
Cells(kR, kCc + 2).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
[B8].Select
'--- vider première colonne file approvisionnement
Range(Cells(kR, kCc + 1), Cells(kR + 4, kCc + 1)).ClearContents
End If
End If
Next kR
'--- envoyer sorties calandreuses vers sortie finale
For kR = 4 To kRcFin Step 6 '--- 4: première ligne produit en première calandre
If Cells(kR, kCc + 7) <> "" Then
Cells(kRSF, kCSF) = Cells(kR, kCc + 7) '--- copie la sortie en Sortie Finale
Cells(kRSF, kCSF + 1) = Cells(kR + 4, kCc + 7) '--- copie la sortie en Sortie Finale
nSF = nSF + 1
kRSF = kRSF + 1
End If
Next kR
Range("Z:Z").ClearContents '--- efface toute la colonne Z (sorties calandres)
'---sorties séchoirs
For kR = 4 To kRsFin Step 6 '--- 4: première ligne produit en premier séchoir
If Cells(kR, kCs + 6) = "" Then
'--- rien, machine vide
Else
If [B8] >= Cells(kR + 4, kCs + 6) Then '--- si l'heure est atteinte
'--- mettre le produit en sortie, en déplaçant toute la file vers la droite
Range(Cells(kR, kCs + 1), Cells(kR + 4, kCs + 6)).Copy
Cells(kR, kCs + 2).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
[B8].Select
'--- vider première colonne file approvisionnement
Range(Cells(kR, kCs + 1), Cells(kR + 4, kCs + 1)).ClearContents
End If
End If
Next kR
'--- envoyer sorties séchoirs vers calandreuses
For kR = 4 To kRsFin Step 6 '--- 4: première ligne produit en premier séchoir
If Cells(kR, kCs + 7) <> "" Then
'SelectionCalandreuse Cells(kR, kCs + 7)
End If
Next kR
Range("R:R").ClearContents '--- efface toute la colonne R (sorties séchoirs)
'---sorties tunnels
For kR = 7 To kRtFin Step 6 '--- 7: première ligne produit en premier tunnel
'--- calcul de l'heure fin dans le tunnel (qui au début n'est pas rempli)
hMax = WorksheetFunction.Max(Range(Cells(kR + 4, kCt + 1), Cells(kR + 4, kCt + 6)))
If hMax = 0 Then
'--- rien: tunnel vide
ElseIf [B8] >= hMax Then '--- heure fin est atteinte
'--- mettre le produit en sortie, en déplaçant toute la file vers la droite
Range(Cells(kR, kCt + 1), Cells(kR + 4, kCt + 6)).Copy
Cells(kR, kCt + 2).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
[B8].Select
'--- vider première colonne file approvisionnement
Range(Cells(kR, kCt + 1), Cells(kR + 4, kCt + 1)).ClearContents
'--- recalculer les heures fin
For kC = kCt + 2 To kCt + 6
If Cells(kR + 2, kC) <> "" Then
Cells(kR + 2, kC) = Cells(kR + 4, kC)
Cells(kR + 4, kC) = Cells(kR + 2, kC) + Cells(kR + 3, kC)
End If
Next kC
End If
Next kR
'--- envoyer sorties tunnels vers séchoirs
For kR = 7 To kRtFin Step 6 '--- 7: première ligne produit en premier tunnel
If Cells(kR, kCt + 7) <> "" Then
'SelectionSechoir Cells(kR, kCt + 7)
End If
Next kR
Range("J:J").ClearContents '--- efface toute la colonne R (sorties séchoirs)
'--- envoyer produit dans tunnel
For kR = 7 To kRtFin Step 6
If Cells(kRFP, 1) <> "" Then '--- il y a un produit
If Cells(kR, kCt + 1) = "" Then
Cells(kR, kCt + 1) = Cells(kRFP, 1) '--- code famille produit suivant liste en colonne 1 ''c'est ici ou il faut intégré le cadencement
Cells(kR + 1, kCt + 1) = [B1] '--- quantité
Cells(kR + 3, kCt + 1) = (100 / 6) / 24 / 60 '--- temps de traitement (durée cycle): 100minutes/6phases
Cells(kR + 2, kCt + 1) = [B8] '--- heure d'entrée = heure simulation
Cells(kR + 4, kCt + 1) = Cells(kR + 2, kCt + 1) + Cells(kR + 3, kCt + 1) '--- heure fin
Cells(kRFP, 3) = [B8] '--- heure envoi en 3e colonne liste produits à traiter
nFP = nFP + 1
kRFP = kRFP + 1
End If
End If
Next kR
End SubEn faite c'est un outil qui simule le déplacement des produits dans les différent étapes de production .
maintenant ma macro elle sélectionne un code produit dans la colonne A et cherche tous c'est information dans la feuilles données et l'envoi ensuite aux étapes de production en suivant les informations du tableau présent dans la feuille des données.
moi ce que je veux faire c'est lui fixé un ordonnancement en colonne B et quand je pointe sur la première valeur de mon ordonnancement (cellule B21 ) Au début de ma simulation ; je cherche ensuite le code produit qui a cette ordonnancement (cellule B21 ) . et je le lance ce code produit dans le processus de production déjà fait .
Exemple
je note que dans le tableau feuille données j'ai l'ordonnancement de chaque code produit dans la colonne H .
j'ai vraiment besoin de votre aide je sais pas comment introduire cette condition dans ma macro
merci
Bonjour.
Que je sois bien sûre de comprendre.
Tu veux au départ avoir ton curseur sur une case de B, si c'est Plat2 du coup ta fonction ne doit traiter que les produits associés à Plat2 soit F33 et F05 ?
Bonne journée.
B
Voila un fichier que j'ai pu mettre qui represente a peu prés ce que la macro fait
merci
oui c'est exactement ca si vous pouvez m'aidez svp n'hésitez pas je suis bloquer sur ca merci
Alors... j'essayerais de faire :
Au début de la fonction
dim init as string
init = ActiveCell.Value
dim N_ligne as integer
N_ligne = 21 ' ta première ligne de code produit
Do until Is Empty (Cells,(i,1))
If Cells(i,2).Value = init
Then
Ta fonction
End if
i = i +1
LoopB
est ce que ce code je le met dans ma macro ?
Option Explicit
Option Base 1 '--- la numérotation des tableaux (arrays) commence à 1
'--- 99 familles de produit
Dim FPcode(99) As String '--- tous les codes DOIVENT se terminer par 2 chiffres 01, 02, ... 99
Dim FPnom(99) As String
Dim FPSechTyp(99) As String
Dim FPSechTemps(99) As Single
Dim FPCalTyp(99) As String
Dim FPCalTemps(99) As Single
'---
Dim kCSF As Long '--- n° colonne Sortie Finale
Dim kRSF As Long '--- n° ligne Sortie Finale
Dim kCt As Long '--- n° colonne tunnels
Dim kCs As Long '--- n° colonne séchoirs
Dim kCc As Long '--- n° colonne calandreuses
Dim kRFP As Long '--- n° ligne famille produit
Dim kRtFin As Long '--- n° dernière ligne tunnel
Dim kRsFin As Long '--- n° dernière ligne séchoirs
Dim kRcFin As Long '--- n° dernière ligne calandres
Dim nFP As Long '--- nombre de produits à traiter
Dim nSF As Long '--- nombre de produits en sortie finale
Private Sub InitialiserFP() '--- FP Famile Produit
Dim wshD As Worksheet, kR As Long, i As Long, t As Variant
Set wshD = ActiveWorkbook.Worksheets("Donnees")
kR = 2 '--- commencer ligne 2
With wshD
While Len(.Cells(kR, 1)) > 0
i = Val(Right(.Cells(kR, 11), 2))
FPnom(i) = .Cells(kR, 1) '--- nom
FPcode(i) = .Cells(kR, 1) '--- code (1 au lieu de 11)
FPSechTyp(i) = .Cells(kR, 6) '--- type séchoir
t = .Cells(kR, 7)
t = Hour(t) * 24 + Minute(t)
FPSechTemps(i) = t / 1440 '--- cycle séchoir (conversion heures en secondes)
FPCalTyp(i) = .Cells(kR, 8) '--- type calandre
FPCalTemps(i) = FPSechTemps(i) '--- cycle calandre = cycle sechoir --- à modifier
kR = kR + 1
'Debug.Print FPcode(i), FPSechTemps(i)
Wend
End With
Set wshD = Nothing
End Sub
Sub Simulation()
Dim dH As String, hFin As Single
'--- initialisatoon
InitialiserFP
nFP = 0
nSF = 0
kCt = [C1].Column '--- colonne Machine Tunnel
kCs = [K1].Column '--- colonne Machine Séchoirs
kCc = [S1].Column '--- colonne Machine Calandres
kCSF = [AA1].Column '--- colonne Sortie Finale
kRcFin = Range("S" & Rows.Count).End(xlUp).Row '--- dernière ligne colonne Z, sorties caladreuses
kRsFin = Range("K" & Rows.Count).End(xlUp).Row '--- dernière ligne colonne R, sorties séchoirs
kRtFin = Range("C" & Rows.Count).End(xlUp).Row '--- dernière ligne colonne J, sorties tunnels
kRSF = 2 '--- première ligne Sortie Finale
kRFP = 21 '--- première ligne famille produit
[B8] = [B6] + 1 '--- 1 jour ======================= simulation sur 1 jour (24 heures)
hFin = [B8] '--- heure fin
dH = 1 / 24 / 60 '--- 1 minute --- pas de temps de la simulation
'--- 1 minute = 1 jour / 24 heures / 60 minutes
[B8] = [B6] '--- B6 heure actuelle = B5 heure départ
'--- boucle de simulation
While [B8] <= hFin
SimulerProduit
[B8] = [B8] + dH
'If MsgBox("Simuler minute " & Format([B8], "hh\h mm\'"), vbYesNo + vbDefaultButton1, "Continuer") = vbNo Then Exit Sub
DoEvents
If nSF = nFP Then
MsgBox "Tous les produits ont été traités"
Exit Sub
End If
Wend
End Sub
Sub SimulerProduit()
Dim kR As Long, hMax As Single, kC As Long
'--- sortir les produits traités de leurs machines
'--- sorties calandreuses
For kR = 4 To kRcFin Step 6 '--- 4: première ligne produit en première calandre
If Cells(kR, kCc + 6) = "" Then
'--- rien, machine vide
Else
If [B8] >= Cells(kR + 4, kCc + 6) Then '--- si l'heure est atteinte
'--- mettre le produit en sortie, en déplaçant toute la file vers la droite
Range(Cells(kR, kCc + 1), Cells(kR + 4, kCc + 6)).Copy
Cells(kR, kCc + 2).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
[B8].Select
'--- vider première colonne file approvisionnement
Range(Cells(kR, kCc + 1), Cells(kR + 4, kCc + 1)).ClearContents
End If
End If
Next kR
'--- envoyer sorties calandreuses vers sortie finale
For kR = 4 To kRcFin Step 6 '--- 4: première ligne produit en première calandre
If Cells(kR, kCc + 7) <> "" Then
Cells(kRSF, kCSF) = Cells(kR, kCc + 7) '--- copie la sortie en Sortie Finale
Cells(kRSF, kCSF + 1) = Cells(kR + 4, kCc + 7) '--- copie la sortie en Sortie Finale
nSF = nSF + 1
kRSF = kRSF + 1
End If
Next kR
Range("Z:Z").ClearContents '--- efface toute la colonne Z (sorties calandres)
'---sorties séchoirs
For kR = 4 To kRsFin Step 6 '--- 4: première ligne produit en premier séchoir
If Cells(kR, kCs + 6) = "" Then
'--- rien, machine vide
Else
If [B8] >= Cells(kR + 4, kCs + 6) Then '--- si l'heure est atteinte
'--- mettre le produit en sortie, en déplaçant toute la file vers la droite
Range(Cells(kR, kCs + 1), Cells(kR + 4, kCs + 6)).Copy
Cells(kR, kCs + 2).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
[B8].Select
'--- vider première colonne file approvisionnement
Range(Cells(kR, kCs + 1), Cells(kR + 4, kCs + 1)).ClearContents
End If
End If
Next kR
'--- envoyer sorties séchoirs vers calandreuses
For kR = 4 To kRsFin Step 6 '--- 4: première ligne produit en premier séchoir
If Cells(kR, kCs + 7) <> "" Then
'SelectionCalandreuse Cells(kR, kCs + 7)
End If
Next kR
Range("R:R").ClearContents '--- efface toute la colonne R (sorties séchoirs)
'---sorties tunnels
For kR = 7 To kRtFin Step 6 '--- 7: première ligne produit en premier tunnel
'--- calcul de l'heure fin dans le tunnel (qui au début n'est pas rempli)
hMax = WorksheetFunction.Max(Range(Cells(kR + 4, kCt + 1), Cells(kR + 4, kCt + 6)))
If hMax = 0 Then
'--- rien: tunnel vide
ElseIf [B8] >= hMax Then '--- heure fin est atteinte
'--- mettre le produit en sortie, en déplaçant toute la file vers la droite
Range(Cells(kR, kCt + 1), Cells(kR + 4, kCt + 6)).Copy
Cells(kR, kCt + 2).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
[B8].Select
'--- vider première colonne file approvisionnement
Range(Cells(kR, kCt + 1), Cells(kR + 4, kCt + 1)).ClearContents
'--- recalculer les heures fin
For kC = kCt + 2 To kCt + 6
If Cells(kR + 2, kC) <> "" Then
Cells(kR + 2, kC) = Cells(kR + 4, kC)
Cells(kR + 4, kC) = Cells(kR + 2, kC) + Cells(kR + 3, kC)
End If
Next kC
End If
Next kR
'--- envoyer sorties tunnels vers séchoirs
For kR = 7 To kRtFin Step 6 '--- 7: première ligne produit en premier tunnel
If Cells(kR, kCt + 7) <> "" Then
'SelectionSechoir Cells(kR, kCt + 7)
End If
Next kR
Range("J:J").ClearContents '--- efface toute la colonne R (sorties séchoirs)
'--- envoyer produit dans tunnel
For kR = 7 To kRtFin Step 6
If Cells(kRFP, 1) <> "" Then '--- il y a un produit
If Cells(kR, kCt + 1) = "" Then
Cells(kR, kCt + 1) = Cells(kRFP, 1) '--- code famille produit suivant liste en colonne 1 ''c'est ici ou il faut intégré le cadencement
Cells(kR + 1, kCt + 1) = [B1] '--- quantité
Cells(kR + 3, kCt + 1) = (100 / 6) / 24 / 60 '--- temps de traitement (durée cycle): 100minutes/6phases
Cells(kR + 2, kCt + 1) = [B8] '--- heure d'entrée = heure simulation
Cells(kR + 4, kCt + 1) = Cells(kR + 2, kCt + 1) + Cells(kR + 3, kCt + 1) '--- heure fin
Cells(kRFP, 3) = [B8] '--- heure envoi en 3e colonne liste produits à traiter
nFP = nFP + 1
kRFP = kRFP + 1
End If
End If
Next kR
End Subsi vous pouvez me le mettre juste a l'emplacement exacte dans ma macro parceque je suis null en vba et je sais pas vraiment ou le mettre
Je saisis pas tout ce que fait ta macro, essaye comme ça et dis moi ce qu'il se passe.
Attention, sur ton fichier les codes produits sont stockés à partir de A combien ? Dans ton petit exemple c'était 21, remplace par le bon chiffre.
Option Explicit
Option Base 1 '--- la numérotation des tableaux (arrays) commence à 1
'--- 99 familles de produit
Dim FPcode(99) As String '--- tous les codes DOIVENT se terminer par 2 chiffres 01, 02, ... 99
Dim FPnom(99) As String
Dim FPSechTyp(99) As String
Dim FPSechTemps(99) As Single
Dim FPCalTyp(99) As String
Dim FPCalTemps(99) As Single
'---
Dim kCSF As Long '--- n° colonne Sortie Finale
Dim kRSF As Long '--- n° ligne Sortie Finale
Dim kCt As Long '--- n° colonne tunnels
Dim kCs As Long '--- n° colonne séchoirs
Dim kCc As Long '--- n° colonne calandreuses
Dim kRFP As Long '--- n° ligne famille produit
Dim kRtFin As Long '--- n° dernière ligne tunnel
Dim kRsFin As Long '--- n° dernière ligne séchoirs
Dim kRcFin As Long '--- n° dernière ligne calandres
Dim nFP As Long '--- nombre de produits à traiter
Dim nSF As Long '--- nombre de produits en sortie finale
Private Sub InitialiserFP() '--- FP Famile Produit
Dim wshD As Worksheet, kR As Long, i As Long, t As Variant
Set wshD = ActiveWorkbook.Worksheets("Donnees")
kR = 2 '--- commencer ligne 2
With wshD
While Len(.Cells(kR, 1)) > 0
i = Val(Right(.Cells(kR, 11), 2))
FPnom(i) = .Cells(kR, 1) '--- nom
FPcode(i) = .Cells(kR, 1) '--- code (1 au lieu de 11)
FPSechTyp(i) = .Cells(kR, 6) '--- type séchoir
t = .Cells(kR, 7)
t = Hour(t) * 24 + Minute(t)
FPSechTemps(i) = t / 1440 '--- cycle séchoir (conversion heures en secondes)
FPCalTyp(i) = .Cells(kR, 8) '--- type calandre
FPCalTemps(i) = FPSechTemps(i) '--- cycle calandre = cycle sechoir --- à modifier
kR = kR + 1
'Debug.Print FPcode(i), FPSechTemps(i)
Wend
End With
Set wshD = Nothing
End Sub
Sub Simulation()
dim init as string
init = ActiveCell.Value
dim N_ligne as integer
N_ligne = 21 ' ta première ligne de code produit
Do until Is Empty (Cells,(i,1))
If Cells(i,2).Value = init
Then
Dim dH As String, hFin As Single
'--- initialisatoon
InitialiserFP
nFP = 0
nSF = 0
kCt = [C1].Column '--- colonne Machine Tunnel
kCs = [K1].Column '--- colonne Machine Séchoirs
kCc = [S1].Column '--- colonne Machine Calandres
kCSF = [AA1].Column '--- colonne Sortie Finale
kRcFin = Range("S" & Rows.Count).End(xlUp).Row '--- dernière ligne colonne Z, sorties caladreuses
kRsFin = Range("K" & Rows.Count).End(xlUp).Row '--- dernière ligne colonne R, sorties séchoirs
kRtFin = Range("C" & Rows.Count).End(xlUp).Row '--- dernière ligne colonne J, sorties tunnels
kRSF = 2 '--- première ligne Sortie Finale
kRFP = 21 '--- première ligne famille produit
[B8] = [B6] + 1 '--- 1 jour ======================= simulation sur 1 jour (24 heures)
hFin = [B8] '--- heure fin
dH = 1 / 24 / 60 '--- 1 minute --- pas de temps de la simulation
'--- 1 minute = 1 jour / 24 heures / 60 minutes
[B8] = [B6] '--- B6 heure actuelle = B5 heure départ
'--- boucle de simulation
While [B8] <= hFin
SimulerProduit
[B8] = [B8] + dH
'If MsgBox("Simuler minute " & Format([B8], "hh\h mm\'"), vbYesNo + vbDefaultButton1, "Continuer") = vbNo Then Exit Sub
DoEvents
If nSF = nFP Then
MsgBox "Tous les produits ont été traités"
Exit Sub
End If
Wend
End if
i = i +1
Loop
End Sub
Sub SimulerProduit()
Dim kR As Long, hMax As Single, kC As Long
'--- sortir les produits traités de leurs machines
'--- sorties calandreuses
For kR = 4 To kRcFin Step 6 '--- 4: première ligne produit en première calandre
If Cells(kR, kCc + 6) = "" Then
'--- rien, machine vide
Else
If [B8] >= Cells(kR + 4, kCc + 6) Then '--- si l'heure est atteinte
'--- mettre le produit en sortie, en déplaçant toute la file vers la droite
Range(Cells(kR, kCc + 1), Cells(kR + 4, kCc + 6)).Copy
Cells(kR, kCc + 2).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
[B8].Select
'--- vider première colonne file approvisionnement
Range(Cells(kR, kCc + 1), Cells(kR + 4, kCc + 1)).ClearContents
End If
End If
Next kR
'--- envoyer sorties calandreuses vers sortie finale
For kR = 4 To kRcFin Step 6 '--- 4: première ligne produit en première calandre
If Cells(kR, kCc + 7) <> "" Then
Cells(kRSF, kCSF) = Cells(kR, kCc + 7) '--- copie la sortie en Sortie Finale
Cells(kRSF, kCSF + 1) = Cells(kR + 4, kCc + 7) '--- copie la sortie en Sortie Finale
nSF = nSF + 1
kRSF = kRSF + 1
End If
Next kR
Range("Z:Z").ClearContents '--- efface toute la colonne Z (sorties calandres)
'---sorties séchoirs
For kR = 4 To kRsFin Step 6 '--- 4: première ligne produit en premier séchoir
If Cells(kR, kCs + 6) = "" Then
'--- rien, machine vide
Else
If [B8] >= Cells(kR + 4, kCs + 6) Then '--- si l'heure est atteinte
'--- mettre le produit en sortie, en déplaçant toute la file vers la droite
Range(Cells(kR, kCs + 1), Cells(kR + 4, kCs + 6)).Copy
Cells(kR, kCs + 2).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
[B8].Select
'--- vider première colonne file approvisionnement
Range(Cells(kR, kCs + 1), Cells(kR + 4, kCs + 1)).ClearContents
End If
End If
Next kR
'--- envoyer sorties séchoirs vers calandreuses
For kR = 4 To kRsFin Step 6 '--- 4: première ligne produit en premier séchoir
If Cells(kR, kCs + 7) <> "" Then
'SelectionCalandreuse Cells(kR, kCs + 7)
End If
Next kR
Range("R:R").ClearContents '--- efface toute la colonne R (sorties séchoirs)
'---sorties tunnels
For kR = 7 To kRtFin Step 6 '--- 7: première ligne produit en premier tunnel
'--- calcul de l'heure fin dans le tunnel (qui au début n'est pas rempli)
hMax = WorksheetFunction.Max(Range(Cells(kR + 4, kCt + 1), Cells(kR + 4, kCt + 6)))
If hMax = 0 Then
'--- rien: tunnel vide
ElseIf [B8] >= hMax Then '--- heure fin est atteinte
'--- mettre le produit en sortie, en déplaçant toute la file vers la droite
Range(Cells(kR, kCt + 1), Cells(kR + 4, kCt + 6)).Copy
Cells(kR, kCt + 2).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
[B8].Select
'--- vider première colonne file approvisionnement
Range(Cells(kR, kCt + 1), Cells(kR + 4, kCt + 1)).ClearContents
'--- recalculer les heures fin
For kC = kCt + 2 To kCt + 6
If Cells(kR + 2, kC) <> "" Then
Cells(kR + 2, kC) = Cells(kR + 4, kC)
Cells(kR + 4, kC) = Cells(kR + 2, kC) + Cells(kR + 3, kC)
End If
Next kC
End If
Next kR
'--- envoyer sorties tunnels vers séchoirs
For kR = 7 To kRtFin Step 6 '--- 7: première ligne produit en premier tunnel
If Cells(kR, kCt + 7) <> "" Then
'SelectionSechoir Cells(kR, kCt + 7)
End If
Next kR
Range("J:J").ClearContents '--- efface toute la colonne R (sorties séchoirs)
'--- envoyer produit dans tunnel
For kR = 7 To kRtFin Step 6
If Cells(kRFP, 1) <> "" Then '--- il y a un produit
If Cells(kR, kCt + 1) = "" Then
Cells(kR, kCt + 1) = Cells(kRFP, 1) '--- code famille produit suivant liste en colonne 1 ''c'est ici ou il faut intégré le cadencement
Cells(kR + 1, kCt + 1) = [B1] '--- quantité
Cells(kR + 3, kCt + 1) = (100 / 6) / 24 / 60 '--- temps de traitement (durée cycle): 100minutes/6phases
Cells(kR + 2, kCt + 1) = [B8] '--- heure d'entrée = heure simulation
Cells(kR + 4, kCt + 1) = Cells(kR + 2, kCt + 1) + Cells(kR + 3, kCt + 1) '--- heure fin
Cells(kRFP, 3) = [B8] '--- heure envoi en 3e colonne liste produits à traiter
nFP = nFP + 1
kRFP = kRFP + 1
End If
End If
Next kR
End SubB
malheureusement il me fait cette erreur
Place then sur la ligne du dessus
Décidément il me faut du café, je suis désolée, je jongle sur deux trois trucs cet aprem et j'ai pas les yeux en face des trous
Remplace i par N_ligne
B
ok est ce que tu peux jeter un oeil dessus après si c'est possible ?
merci
Option Explicit
Option Base 1 '--- la numérotation des tableaux (arrays) commence à 1
'--- 99 familles de produit
Dim FPcode(99) As String '--- tous les codes DOIVENT se terminer par 2 chiffres 01, 02, ... 99
Dim FPnom(99) As String
Dim FPSechTyp(99) As String
Dim FPSechTemps(99) As Single
Dim FPCalTyp(99) As String
Dim FPCalTemps(99) As Single
'---
Dim kCSF As Long '--- n° colonne Sortie Finale
Dim kRSF As Long '--- n° ligne Sortie Finale
Dim kCt As Long '--- n° colonne tunnels
Dim kCs As Long '--- n° colonne séchoirs
Dim kCc As Long '--- n° colonne calandreuses
Dim kRFP As Long '--- n° ligne famille produit
Dim kRtFin As Long '--- n° dernière ligne tunnel
Dim kRsFin As Long '--- n° dernière ligne séchoirs
Dim kRcFin As Long '--- n° dernière ligne calandres
Dim nFP As Long '--- nombre de produits à traiter
Dim nSF As Long '--- nombre de produits en sortie finale
Private Sub InitialiserFP() '--- FP Famile Produit
Dim wshD As Worksheet, kR As Long, i As Long, t As Variant
Set wshD = ActiveWorkbook.Worksheets("Donnees")
kR = 2 '--- commencer ligne 2
With wshD
While Len(.Cells(kR, 1)) > 0
i = Val(Right(.Cells(kR, 11), 2))
FPnom(i) = .Cells(kR, 1) '--- nom
FPcode(i) = .Cells(kR, 1) '--- code (1 au lieu de 11)
FPSechTyp(i) = .Cells(kR, 6) '--- type séchoir
t = .Cells(kR, 7)
t = Hour(t) * 24 + Minute(t)
FPSechTemps(i) = t / 1440 '--- cycle séchoir (conversion heures en secondes)
FPCalTyp(i) = .Cells(kR, 8) '--- type calandre
FPCalTemps(i) = FPSechTemps(i) '--- cycle calandre = cycle sechoir --- à modifier
kR = kR + 1
'Debug.Print FPcode(i), FPSechTemps(i)
Wend
End With
Set wshD = Nothing
End Sub
Sub Simulation()
dim init as string
init = ActiveCell.Value
dim N_ligne as integer
N_ligne = 21 ' ta première ligne de code produit
Do until IsEmpty (Cells,(N_ligne,1))
If Cells(N_ligne,2).Value = init Then
Dim dH As String, hFin As Single
'--- initialisatoon
InitialiserFP
nFP = 0
nSF = 0
kCt = [C1].Column '--- colonne Machine Tunnel
kCs = [K1].Column '--- colonne Machine Séchoirs
kCc = [S1].Column '--- colonne Machine Calandres
kCSF = [AA1].Column '--- colonne Sortie Finale
kRcFin = Range("S" & Rows.Count).End(xlUp).Row '--- dernière ligne colonne Z, sorties caladreuses
kRsFin = Range("K" & Rows.Count).End(xlUp).Row '--- dernière ligne colonne R, sorties séchoirs
kRtFin = Range("C" & Rows.Count).End(xlUp).Row '--- dernière ligne colonne J, sorties tunnels
kRSF = 2 '--- première ligne Sortie Finale
kRFP = 21 '--- première ligne famille produit
[B8] = [B6] + 1 '--- 1 jour ======================= simulation sur 1 jour (24 heures)
hFin = [B8] '--- heure fin
dH = 1 / 24 / 60 '--- 1 minute --- pas de temps de la simulation
'--- 1 minute = 1 jour / 24 heures / 60 minutes
[B8] = [B6] '--- B6 heure actuelle = B5 heure départ
'--- boucle de simulation
While [B8] <= hFin
SimulerProduit
[B8] = [B8] + dH
'If MsgBox("Simuler minute " & Format([B8], "hh\h mm\'"), vbYesNo + vbDefaultButton1, "Continuer") = vbNo Then Exit Sub
DoEvents
If nSF = nFP Then
MsgBox "Tous les produits ont été traités"
Exit Sub
End If
Wend
End if
N_ligne= N_ligne+1
Loop
End Sub
Sub SimulerProduit()
Dim kR As Long, hMax As Single, kC As Long
'--- sortir les produits traités de leurs machines
'--- sorties calandreuses
For kR = 4 To kRcFin Step 6 '--- 4: première ligne produit en première calandre
If Cells(kR, kCc + 6) = "" Then
'--- rien, machine vide
Else
If [B8] >= Cells(kR + 4, kCc + 6) Then '--- si l'heure est atteinte
'--- mettre le produit en sortie, en déplaçant toute la file vers la droite
Range(Cells(kR, kCc + 1), Cells(kR + 4, kCc + 6)).Copy
Cells(kR, kCc + 2).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
[B8].Select
'--- vider première colonne file approvisionnement
Range(Cells(kR, kCc + 1), Cells(kR + 4, kCc + 1)).ClearContents
End If
End If
Next kR
'--- envoyer sorties calandreuses vers sortie finale
For kR = 4 To kRcFin Step 6 '--- 4: première ligne produit en première calandre
If Cells(kR, kCc + 7) <> "" Then
Cells(kRSF, kCSF) = Cells(kR, kCc + 7) '--- copie la sortie en Sortie Finale
Cells(kRSF, kCSF + 1) = Cells(kR + 4, kCc + 7) '--- copie la sortie en Sortie Finale
nSF = nSF + 1
kRSF = kRSF + 1
End If
Next kR
Range("Z:Z").ClearContents '--- efface toute la colonne Z (sorties calandres)
'---sorties séchoirs
For kR = 4 To kRsFin Step 6 '--- 4: première ligne produit en premier séchoir
If Cells(kR, kCs + 6) = "" Then
'--- rien, machine vide
Else
If [B8] >= Cells(kR + 4, kCs + 6) Then '--- si l'heure est atteinte
'--- mettre le produit en sortie, en déplaçant toute la file vers la droite
Range(Cells(kR, kCs + 1), Cells(kR + 4, kCs + 6)).Copy
Cells(kR, kCs + 2).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
[B8].Select
'--- vider première colonne file approvisionnement
Range(Cells(kR, kCs + 1), Cells(kR + 4, kCs + 1)).ClearContents
End If
End If
Next kR
'--- envoyer sorties séchoirs vers calandreuses
For kR = 4 To kRsFin Step 6 '--- 4: première ligne produit en premier séchoir
If Cells(kR, kCs + 7) <> "" Then
'SelectionCalandreuse Cells(kR, kCs + 7)
End If
Next kR
Range("R:R").ClearContents '--- efface toute la colonne R (sorties séchoirs)
'---sorties tunnels
For kR = 7 To kRtFin Step 6 '--- 7: première ligne produit en premier tunnel
'--- calcul de l'heure fin dans le tunnel (qui au début n'est pas rempli)
hMax = WorksheetFunction.Max(Range(Cells(kR + 4, kCt + 1), Cells(kR + 4, kCt + 6)))
If hMax = 0 Then
'--- rien: tunnel vide
ElseIf [B8] >= hMax Then '--- heure fin est atteinte
'--- mettre le produit en sortie, en déplaçant toute la file vers la droite
Range(Cells(kR, kCt + 1), Cells(kR + 4, kCt + 6)).Copy
Cells(kR, kCt + 2).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
[B8].Select
'--- vider première colonne file approvisionnement
Range(Cells(kR, kCt + 1), Cells(kR + 4, kCt + 1)).ClearContents
'--- recalculer les heures fin
For kC = kCt + 2 To kCt + 6
If Cells(kR + 2, kC) <> "" Then
Cells(kR + 2, kC) = Cells(kR + 4, kC)
Cells(kR + 4, kC) = Cells(kR + 2, kC) + Cells(kR + 3, kC)
End If
Next kC
End If
Next kR
'--- envoyer sorties tunnels vers séchoirs
For kR = 7 To kRtFin Step 6 '--- 7: première ligne produit en premier tunnel
If Cells(kR, kCt + 7) <> "" Then
'SelectionSechoir Cells(kR, kCt + 7)
End If
Next kR
Range("J:J").ClearContents '--- efface toute la colonne R (sorties séchoirs)
'--- envoyer produit dans tunnel
For kR = 7 To kRtFin Step 6
If Cells(kRFP, 1) <> "" Then '--- il y a un produit
If Cells(kR, kCt + 1) = "" Then
Cells(kR, kCt + 1) = Cells(kRFP, 1) '--- code famille produit suivant liste en colonne 1 ''c'est ici ou il faut intégré le cadencement
Cells(kR + 1, kCt + 1) = [B1] '--- quantité
Cells(kR + 3, kCt + 1) = (100 / 6) / 24 / 60 '--- temps de traitement (durée cycle): 100minutes/6phases
Cells(kR + 2, kCt + 1) = [B8] '--- heure d'entrée = heure simulation
Cells(kR + 4, kCt + 1) = Cells(kR + 2, kCt + 1) + Cells(kR + 3, kCt + 1) '--- heure fin
Cells(kRFP, 3) = [B8] '--- heure envoi en 3e colonne liste produits à traiter
nFP = nFP + 1
kRFP = kRFP + 1
End If
End If
Next kR
End SubB
JE SAIS PAS POURQUOI CA MARCHE PAS
prend ton temps Elhevan pour résoudre le problème je suis pas pressé tu peux me le faire pour demain ?
merciii
cordialement
Qu'est-ce que ça te dit comme erreur avant de le mettre en rouge ?
Et tu n'as pas répondu tout à l'heure, dans la feuille sur laquelle tu as les codes, où sont-ils ?
Option Explicit
Option Base 1 '--- la numérotation des tableaux (arrays) commence à 1
'--- 99 familles de produit
Dim FPcode(99) As String '--- tous les codes DOIVENT se terminer par 2 chiffres 01, 02, ... 99
Dim FPnom(99) As String
Dim FPSechTyp(99) As String
Dim FPSechTemps(99) As Single
Dim FPCalTyp(99) As String
Dim FPCalTemps(99) As Single
'---
Dim kCSF As Long '--- n° colonne Sortie Finale
Dim kRSF As Long '--- n° ligne Sortie Finale
Dim kCt As Long '--- n° colonne tunnels
Dim kCs As Long '--- n° colonne séchoirs
Dim kCc As Long '--- n° colonne calandreuses
Dim kRFP As Long '--- n° ligne famille produit
Dim kRtFin As Long '--- n° dernière ligne tunnel
Dim kRsFin As Long '--- n° dernière ligne séchoirs
Dim kRcFin As Long '--- n° dernière ligne calandres
Dim nFP As Long '--- nombre de produits à traiter
Dim nSF As Long '--- nombre de produits en sortie finale
Private Sub InitialiserFP() '--- FP Famile Produit
Dim wshD As Worksheet, kR As Long, i As Long, t As Variant
Set wshD = ActiveWorkbook.Worksheets("Donnees")
kR = 2 '--- commencer ligne 2
With wshD
While Len(.Cells(kR, 1)) > 0
i = Val(Right(.Cells(kR, 11), 2))
FPnom(i) = .Cells(kR, 1) '--- nom
FPcode(i) = .Cells(kR, 1) '--- code (1 au lieu de 11)
FPSechTyp(i) = .Cells(kR, 6) '--- type séchoir
t = .Cells(kR, 7)
t = Hour(t) * 24 + Minute(t)
FPSechTemps(i) = t / 1440 '--- cycle séchoir (conversion heures en secondes)
FPCalTyp(i) = .Cells(kR, 8) '--- type calandre
FPCalTemps(i) = FPSechTemps(i) '--- cycle calandre = cycle sechoir --- à modifier
kR = kR + 1
'Debug.Print FPcode(i), FPSechTemps(i)
Wend
End With
Set wshD = Nothing
End Sub
Sub Simulation()
dim init as string
init = ActiveCell.Value
dim N_ligne as integer
N_ligne = 21 ' ta première ligne de code produit
Do until IsEmpty (Cells(N_ligne,1))
If Cells(N_ligne,2).Value = init Then
Dim dH As String, hFin As Single
'--- initialisatoon
InitialiserFP
nFP = 0
nSF = 0
kCt = [C1].Column '--- colonne Machine Tunnel
kCs = [K1].Column '--- colonne Machine Séchoirs
kCc = [S1].Column '--- colonne Machine Calandres
kCSF = [AA1].Column '--- colonne Sortie Finale
kRcFin = Range("S" & Rows.Count).End(xlUp).Row '--- dernière ligne colonne Z, sorties caladreuses
kRsFin = Range("K" & Rows.Count).End(xlUp).Row '--- dernière ligne colonne R, sorties séchoirs
kRtFin = Range("C" & Rows.Count).End(xlUp).Row '--- dernière ligne colonne J, sorties tunnels
kRSF = 2 '--- première ligne Sortie Finale
kRFP = 21 '--- première ligne famille produit
[B8] = [B6] + 1 '--- 1 jour ======================= simulation sur 1 jour (24 heures)
hFin = [B8] '--- heure fin
dH = 1 / 24 / 60 '--- 1 minute --- pas de temps de la simulation
'--- 1 minute = 1 jour / 24 heures / 60 minutes
[B8] = [B6] '--- B6 heure actuelle = B5 heure départ
'--- boucle de simulation
While [B8] <= hFin
SimulerProduit
[B8] = [B8] + dH
'If MsgBox("Simuler minute " & Format([B8], "hh\h mm\'"), vbYesNo + vbDefaultButton1, "Continuer") = vbNo Then Exit Sub
DoEvents
If nSF = nFP Then
MsgBox "Tous les produits ont été traités"
Exit Sub
End If
Wend
End if
N_ligne= N_ligne+1
Loop
End Sub
Sub SimulerProduit()
Dim kR As Long, hMax As Single, kC As Long
'--- sortir les produits traités de leurs machines
'--- sorties calandreuses
For kR = 4 To kRcFin Step 6 '--- 4: première ligne produit en première calandre
If Cells(kR, kCc + 6) = "" Then
'--- rien, machine vide
Else
If [B8] >= Cells(kR + 4, kCc + 6) Then '--- si l'heure est atteinte
'--- mettre le produit en sortie, en déplaçant toute la file vers la droite
Range(Cells(kR, kCc + 1), Cells(kR + 4, kCc + 6)).Copy
Cells(kR, kCc + 2).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
[B8].Select
'--- vider première colonne file approvisionnement
Range(Cells(kR, kCc + 1), Cells(kR + 4, kCc + 1)).ClearContents
End If
End If
Next kR
'--- envoyer sorties calandreuses vers sortie finale
For kR = 4 To kRcFin Step 6 '--- 4: première ligne produit en première calandre
If Cells(kR, kCc + 7) <> "" Then
Cells(kRSF, kCSF) = Cells(kR, kCc + 7) '--- copie la sortie en Sortie Finale
Cells(kRSF, kCSF + 1) = Cells(kR + 4, kCc + 7) '--- copie la sortie en Sortie Finale
nSF = nSF + 1
kRSF = kRSF + 1
End If
Next kR
Range("Z:Z").ClearContents '--- efface toute la colonne Z (sorties calandres)
'---sorties séchoirs
For kR = 4 To kRsFin Step 6 '--- 4: première ligne produit en premier séchoir
If Cells(kR, kCs + 6) = "" Then
'--- rien, machine vide
Else
If [B8] >= Cells(kR + 4, kCs + 6) Then '--- si l'heure est atteinte
'--- mettre le produit en sortie, en déplaçant toute la file vers la droite
Range(Cells(kR, kCs + 1), Cells(kR + 4, kCs + 6)).Copy
Cells(kR, kCs + 2).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
[B8].Select
'--- vider première colonne file approvisionnement
Range(Cells(kR, kCs + 1), Cells(kR + 4, kCs + 1)).ClearContents
End If
End If
Next kR
'--- envoyer sorties séchoirs vers calandreuses
For kR = 4 To kRsFin Step 6 '--- 4: première ligne produit en premier séchoir
If Cells(kR, kCs + 7) <> "" Then
'SelectionCalandreuse Cells(kR, kCs + 7)
End If
Next kR
Range("R:R").ClearContents '--- efface toute la colonne R (sorties séchoirs)
'---sorties tunnels
For kR = 7 To kRtFin Step 6 '--- 7: première ligne produit en premier tunnel
'--- calcul de l'heure fin dans le tunnel (qui au début n'est pas rempli)
hMax = WorksheetFunction.Max(Range(Cells(kR + 4, kCt + 1), Cells(kR + 4, kCt + 6)))
If hMax = 0 Then
'--- rien: tunnel vide
ElseIf [B8] >= hMax Then '--- heure fin est atteinte
'--- mettre le produit en sortie, en déplaçant toute la file vers la droite
Range(Cells(kR, kCt + 1), Cells(kR + 4, kCt + 6)).Copy
Cells(kR, kCt + 2).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
[B8].Select
'--- vider première colonne file approvisionnement
Range(Cells(kR, kCt + 1), Cells(kR + 4, kCt + 1)).ClearContents
'--- recalculer les heures fin
For kC = kCt + 2 To kCt + 6
If Cells(kR + 2, kC) <> "" Then
Cells(kR + 2, kC) = Cells(kR + 4, kC)
Cells(kR + 4, kC) = Cells(kR + 2, kC) + Cells(kR + 3, kC)
End If
Next kC
End If
Next kR
'--- envoyer sorties tunnels vers séchoirs
For kR = 7 To kRtFin Step 6 '--- 7: première ligne produit en premier tunnel
If Cells(kR, kCt + 7) <> "" Then
'SelectionSechoir Cells(kR, kCt + 7)
End If
Next kR
Range("J:J").ClearContents '--- efface toute la colonne R (sorties séchoirs)
'--- envoyer produit dans tunnel
For kR = 7 To kRtFin Step 6
If Cells(kRFP, 1) <> "" Then '--- il y a un produit
If Cells(kR, kCt + 1) = "" Then
Cells(kR, kCt + 1) = Cells(kRFP, 1) '--- code famille produit suivant liste en colonne 1 ''c'est ici ou il faut intégré le cadencement
Cells(kR + 1, kCt + 1) = [B1] '--- quantité
Cells(kR + 3, kCt + 1) = (100 / 6) / 24 / 60 '--- temps de traitement (durée cycle): 100minutes/6phases
Cells(kR + 2, kCt + 1) = [B8] '--- heure d'entrée = heure simulation
Cells(kR + 4, kCt + 1) = Cells(kR + 2, kCt + 1) + Cells(kR + 3, kCt + 1) '--- heure fin
Cells(kRFP, 3) = [B8] '--- heure envoi en 3e colonne liste produits à traiter
nFP = nFP + 1
kRFP = kRFP + 1
End If
End If
Next kR
End Sub
B
Merci mais malheureusement ca marche pas quand meme si j'ai plus la ligne en rouge mais malheureusement ma macro tourne pas
Elhevan a écrit :Et tu n'as pas répondu tout à l'heure, dans la feuille sur laquelle tu as les codes, où sont-ils ?
B
mon code il est dans un module je comprend pas la question ?!!
Le code de tes produits sur ta page excel. Idem pour les plats.
B
le code produit et mes Plat son dans la feuille Interface
?
Option Explicit
Option Base 1 '--- la numérotation des tableaux (arrays) commence à 1
'--- 99 familles de produit
Dim FPcode(99) As String '--- tous les codes DOIVENT se terminer par 2 chiffres 01, 02, ... 99
Dim FPnom(99) As String
Dim FPSechTyp(99) As String
Dim FPSechTemps(99) As Single
Dim FPCalTyp(99) As String
Dim FPCalTemps(99) As Single
'---
Dim kCSF As Long '--- n° colonne Sortie Finale
Dim kRSF As Long '--- n° ligne Sortie Finale
Dim kCt As Long '--- n° colonne tunnels
Dim kCs As Long '--- n° colonne séchoirs
Dim kCc As Long '--- n° colonne calandreuses
Dim kRFP As Long '--- n° ligne famille produit
Dim kRtFin As Long '--- n° dernière ligne tunnel
Dim kRsFin As Long '--- n° dernière ligne séchoirs
Dim kRcFin As Long '--- n° dernière ligne calandres
Dim nFP As Long '--- nombre de produits à traiter
Dim nSF As Long '--- nombre de produits en sortie finale
Private Sub InitialiserFP() '--- FP Famile Produit
Dim wshD As Worksheet, kR As Long, i As Long, t As Variant
Set wshD = ActiveWorkbook.Worksheets("Donnees")
kR = 2 '--- commencer ligne 2
With wshD
While Len(.Cells(kR, 1)) > 0
i = Val(Right(.Cells(kR, 11), 2))
FPnom(i) = .Cells(kR, 1) '--- nom
FPcode(i) = .Cells(kR, 1) '--- code (1 au lieu de 11)
FPSechTyp(i) = .Cells(kR, 6) '--- type séchoir
t = .Cells(kR, 7)
t = Hour(t) * 24 + Minute(t)
FPSechTemps(i) = t / 1440 '--- cycle séchoir (conversion heures en secondes)
FPCalTyp(i) = .Cells(kR, 8) '--- type calandre
FPCalTemps(i) = FPSechTemps(i) '--- cycle calandre = cycle sechoir --- à modifier
kR = kR + 1
'Debug.Print FPcode(i), FPSechTemps(i)
Wend
End With
Set wshD = Nothing
End Sub
Sub Simulation()
dim init as string
init = ActiveCell.Value
dim N_ligne as integer
N_ligne = 21 ' ta première ligne de code produit
Do until IsEmpty (Worksheets("Interface").Cells(N_ligne,1))
If Worksheets("Interface").Cells(N_ligne,2).Value = init Then
Dim dH As String, hFin As Single
'--- initialisatoon
InitialiserFP
nFP = 0
nSF = 0
kCt = [C1].Column '--- colonne Machine Tunnel
kCs = [K1].Column '--- colonne Machine Séchoirs
kCc = [S1].Column '--- colonne Machine Calandres
kCSF = [AA1].Column '--- colonne Sortie Finale
kRcFin = Range("S" & Rows.Count).End(xlUp).Row '--- dernière ligne colonne Z, sorties caladreuses
kRsFin = Range("K" & Rows.Count).End(xlUp).Row '--- dernière ligne colonne R, sorties séchoirs
kRtFin = Range("C" & Rows.Count).End(xlUp).Row '--- dernière ligne colonne J, sorties tunnels
kRSF = 2 '--- première ligne Sortie Finale
kRFP = 21 '--- première ligne famille produit
[B8] = [B6] + 1 '--- 1 jour ======================= simulation sur 1 jour (24 heures)
hFin = [B8] '--- heure fin
dH = 1 / 24 / 60 '--- 1 minute --- pas de temps de la simulation
'--- 1 minute = 1 jour / 24 heures / 60 minutes
[B8] = [B6] '--- B6 heure actuelle = B5 heure départ
'--- boucle de simulation
While [B8] <= hFin
SimulerProduit
[B8] = [B8] + dH
'If MsgBox("Simuler minute " & Format([B8], "hh\h mm\'"), vbYesNo + vbDefaultButton1, "Continuer") = vbNo Then Exit Sub
DoEvents
If nSF = nFP Then
MsgBox "Tous les produits ont été traités"
Exit Sub
End If
Wend
End if
N_ligne= N_ligne+1
Loop
End Sub
Sub SimulerProduit()
Dim kR As Long, hMax As Single, kC As Long
'--- sortir les produits traités de leurs machines
'--- sorties calandreuses
For kR = 4 To kRcFin Step 6 '--- 4: première ligne produit en première calandre
If Cells(kR, kCc + 6) = "" Then
'--- rien, machine vide
Else
If [B8] >= Cells(kR + 4, kCc + 6) Then '--- si l'heure est atteinte
'--- mettre le produit en sortie, en déplaçant toute la file vers la droite
Range(Cells(kR, kCc + 1), Cells(kR + 4, kCc + 6)).Copy
Cells(kR, kCc + 2).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
[B8].Select
'--- vider première colonne file approvisionnement
Range(Cells(kR, kCc + 1), Cells(kR + 4, kCc + 1)).ClearContents
End If
End If
Next kR
'--- envoyer sorties calandreuses vers sortie finale
For kR = 4 To kRcFin Step 6 '--- 4: première ligne produit en première calandre
If Cells(kR, kCc + 7) <> "" Then
Cells(kRSF, kCSF) = Cells(kR, kCc + 7) '--- copie la sortie en Sortie Finale
Cells(kRSF, kCSF + 1) = Cells(kR + 4, kCc + 7) '--- copie la sortie en Sortie Finale
nSF = nSF + 1
kRSF = kRSF + 1
End If
Next kR
Range("Z:Z").ClearContents '--- efface toute la colonne Z (sorties calandres)
'---sorties séchoirs
For kR = 4 To kRsFin Step 6 '--- 4: première ligne produit en premier séchoir
If Cells(kR, kCs + 6) = "" Then
'--- rien, machine vide
Else
If [B8] >= Cells(kR + 4, kCs + 6) Then '--- si l'heure est atteinte
'--- mettre le produit en sortie, en déplaçant toute la file vers la droite
Range(Cells(kR, kCs + 1), Cells(kR + 4, kCs + 6)).Copy
Cells(kR, kCs + 2).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
[B8].Select
'--- vider première colonne file approvisionnement
Range(Cells(kR, kCs + 1), Cells(kR + 4, kCs + 1)).ClearContents
End If
End If
Next kR
'--- envoyer sorties séchoirs vers calandreuses
For kR = 4 To kRsFin Step 6 '--- 4: première ligne produit en premier séchoir
If Cells(kR, kCs + 7) <> "" Then
'SelectionCalandreuse Cells(kR, kCs + 7)
End If
Next kR
Range("R:R").ClearContents '--- efface toute la colonne R (sorties séchoirs)
'---sorties tunnels
For kR = 7 To kRtFin Step 6 '--- 7: première ligne produit en premier tunnel
'--- calcul de l'heure fin dans le tunnel (qui au début n'est pas rempli)
hMax = WorksheetFunction.Max(Range(Cells(kR + 4, kCt + 1), Cells(kR + 4, kCt + 6)))
If hMax = 0 Then
'--- rien: tunnel vide
ElseIf [B8] >= hMax Then '--- heure fin est atteinte
'--- mettre le produit en sortie, en déplaçant toute la file vers la droite
Range(Cells(kR, kCt + 1), Cells(kR + 4, kCt + 6)).Copy
Cells(kR, kCt + 2).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
[B8].Select
'--- vider première colonne file approvisionnement
Range(Cells(kR, kCt + 1), Cells(kR + 4, kCt + 1)).ClearContents
'--- recalculer les heures fin
For kC = kCt + 2 To kCt + 6
If Cells(kR + 2, kC) <> "" Then
Cells(kR + 2, kC) = Cells(kR + 4, kC)
Cells(kR + 4, kC) = Cells(kR + 2, kC) + Cells(kR + 3, kC)
End If
Next kC
End If
Next kR
'--- envoyer sorties tunnels vers séchoirs
For kR = 7 To kRtFin Step 6 '--- 7: première ligne produit en premier tunnel
If Cells(kR, kCt + 7) <> "" Then
'SelectionSechoir Cells(kR, kCt + 7)
End If
Next kR
Range("J:J").ClearContents '--- efface toute la colonne R (sorties séchoirs)
'--- envoyer produit dans tunnel
For kR = 7 To kRtFin Step 6
If Cells(kRFP, 1) <> "" Then '--- il y a un produit
If Cells(kR, kCt + 1) = "" Then
Cells(kR, kCt + 1) = Cells(kRFP, 1) '--- code famille produit suivant liste en colonne 1 ''c'est ici ou il faut intégré le cadencement
Cells(kR + 1, kCt + 1) = [B1] '--- quantité
Cells(kR + 3, kCt + 1) = (100 / 6) / 24 / 60 '--- temps de traitement (durée cycle): 100minutes/6phases
Cells(kR + 2, kCt + 1) = [B8] '--- heure d'entrée = heure simulation
Cells(kR + 4, kCt + 1) = Cells(kR + 2, kCt + 1) + Cells(kR + 3, kCt + 1) '--- heure fin
Cells(kRFP, 3) = [B8] '--- heure envoi en 3e colonne liste produits à traiter
nFP = nFP + 1
kRFP = kRFP + 1
End If
End If
Next kR
End Sub