Bonjour tout le monde,
J'aurais besoin de votre aide pour la compréhension du code VBA que vous pourrez trouvez ci-dessous qui à pour but d'optimiser la découpe de barre en fonction d'une longueur donnée :
J'ai pour projet de réaliser un fichier Excel qui permet d'insérer un fichier .csv qui comprend toute les barres dont j'ai besoin puis, d'automatiquement optimiser la découpe des barres en fonction d'une seule longueur.
J'ai bien avancé sur ce projet, un formulaire s'ouvre à l'ouverture du fichier et je peux sélectionner mon .csv puis celui-ci est insérer dans une feuille puis les données de longueurs et de quantités sont copiées dans une autre feuille.
Désormais je bloque au niveau de l'optimisation. J'ai la volonté de réaliser ce type de macro, le problème étant que je ne comprend pas le fonctionnement de la macro et je n'ai pas envie de simplement copier-coller le code existant dans mon projet, j'ai la réelle envie de comprendre comment faire.
Je vous remercie d'avance pour votre aide.
Bonne journée.
J'aurais besoin de votre aide pour la compréhension du code VBA que vous pourrez trouvez ci-dessous qui à pour but d'optimiser la découpe de barre en fonction d'une longueur donnée :
VB:
' Decouli simple
Dim K1 As Integer, K2 As Integer, K3 As Integer, K4 As Integer, N As Integer, K As Integer
Dim TVAL(1000) As Long, TQ(1000) As Long, TLib(1000) As String ' dim 1000
Dim TSol(1000) As Long ' Solution pour la barre étudiée ' Dim 1000
Dim TNoeud(1000) As Integer ' N° de ligne du Noeud étudié
Dim TTOT(1000) As Long ' Longueur Totale jusqu'à ce Noeud
Dim TAux(100) As Long ' tableau de valeurs auxiliaires ' dim 100
Dim NomFeuille As String, AERR As String
Dim ChuteAcceptable As Long, LongueurBarres As Long, Morceau As Long, TOTAL As Long, CHUTE As Long
Dim A1 As Variant, LigneBas As Integer
Sub Découpe2()
' Macro enregistrée le 11/01/2002 par Jean DUPRAT, Aménagée le 08/03/12
' 1°) Préparation des données
' 2°) Trouver une bonne solution
' Les différentes solutions sont considérées comme
' les Noeuds d'une arborescence
' dont on examine toutes les branches.
Mess0 = "Découpe Linéaire": MessF = "Travail Terminé"
On Error GoTo NIVERR
' =============================================================
' 1°) Préparation des données et Constantes
K1 = 1 ' colonne des dimensions
K2 = 2 ' colonne des quantités par dimension
K3 = 3 ' colonne des libellés
K4 = 5 ' colonne des paramètres
Sheets("demande2").Activate
' 1-1) Contrôle des données
NomFeuille = ActiveSheet.Name
If Cells(1, K1) < "A" Then GoTo NIVERR1
LigneDébut = 2: A1 = Cells(LigneDébut, K1)
If IsNumeric(A1) = False Then GoTo NIVERR1
LongueurBarres = Cells(2, K4)
If LongueurBarres = 0 Then GoTo NIVERR1
ChuteAcceptable = Cells(3, K4)
If ChuteAcceptable > LongueurBarres / 2 Then GoTo NIVERR1
'1-2) Report dans la feuille Travail
KK = 9 ' colonne cumuls. ATTENTION modifier aussi dans Report( )
' Lecture des données
N = 1
NIV1:
N = N + 1: Morceau = Cells(N, K1): If Morceau = 0 Then GoTo NIV12
If Morceau > LongueurBarres Then GoTo NIVERR4
If N > 1000 Then GoTo NIVERR2
Q = Cells(N, K2): If Q < 1 Then Q = 1
TVAL(N) = Morceau: TQ(N) = Q: TLib(N) = Cells(N, K3)
GoTo NIV1
NIV12:
LigneBas = N - 1
For N = LigneBas + 1 To 1000 ' sécurité
TVAL(N) = Empty: TQ(N) = Empty: TLib(N) = Empty
TVAL(N) = Morceau: TQ(N) = Q: TLib(N) = Cells(N, K3)
Next N
' report dans la feuille Travail
Sheets("Travail2").Activate
Cells(4, KK + 7) = "Recherche en cours"
Cells(6, KK + 7) = NomFeuille
Columns("A:B").Activate: Selection.ClearContents
Range("A1").Value = Sheets(NomFeuille).Range("A1").Value
Range("B1").Value = Sheets(NomFeuille).Range("C1").Value
LigneFin = 1
For N = 2 To LigneBas: Morceau = TVAL(N)
If LigneFin > 1000 Then GoTo NIVERR3
For K = 1 To TQ(N): LigneFin = LigneFin + 1
Cells(LigneFin, 1) = Morceau
If K = 1 Then Cells(LigneFin, 2) = TLib(N)
If K <> 1 Then Cells(LigneFin, 2) = TLib(N)
Next K
Next N
Cells(2, KK + 6) = LigneFin - LigneDébut + 1
'1-3) Tri
Columns("A:B").Activate
Selection.Sort Key1:=Range("A2"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
' Contrôle sur la plus petite dimension demandée
If ChuteAcceptable > Cells(LigneFin, 1) Then GoTo NIVERR1
'1-4) on double la colonne A dans la colonne K
Columns("A:B").Copy
Columns("K:L").Activate
ActiveSheet.Paste
Application.CutCopyMode = False
Cells(1, 11) = ""
Cells(1, 12) = ""
'1-5) Vidage de l'ancienne solution, colonnes C-D-E-F
Range("C1:I1").Activate
Selection.Cut Destination:=Range("AC1:AH1")
Columns("C:I").Activate
Selection.ClearContents
Range("AC1:AI1").Activate
Selection.Cut Destination:=Range("C1:I1")
NombreBarres = 0: Cells(3, KK + 6) = NombreBarres
'1-6) tableaux de travail
TAux(1) = 0 'Nombre de solutions testées par barre
TAux(2) = 0 'Nbre de solutions améliorées
TAux(3) = LigneFin * LigneFin ' Limitateur de bouclage
If LigneFin > 50 Then TAux(3) = 4 * LigneFin
LigneReport = 1 ' ligne de report des résultats
Cells(5, KK + 6) = TAux(1) ' Nombre de solutions
' ============================================================
' 2°) C'est parti !
' essai du sous-programme Report()
' TSol(1) = 2: TSol(2) = 4
' Call Report(TSol, 2, LigneReport, NombreBarres, LongueurBarres, LigneFin, TAux)
' début du suivi de l'arborescence
NIV2:
AERR = "NIV2:"
If LigneFin < LigneDébut Then Range("A1").Activate: GoTo FINI
' 2-1) On prend le 1er morceau
TSol(1) = 2: TAux(1) = TAux(1) + 1
If LigneFin = LigneDébut Then
Call Report(TSol, 1, LigneReport, NombreBarres, LongueurBarres, LigneFin, TAux)
GoTo FINI
End If
Morceau = Cells(2, 11): DernierMorceau = Cells(LigneFin, 11)
If Morceau + DernierMorceau > LongueurBarres Then
Call Report(TSol, 1, LigneReport, NombreBarres, LongueurBarres, LigneFin, TAux)
GoTo NIV2
End If
' 2-2) On cherche la combinaison qui donnera le moins de chute avec ce morceau
AERR = "NIV2-2)"
ligne = LigneDébut: TOTAL = Morceau: AncienneChute = LongueurBarres + 1
Noeud = 1: TNoeud(1) = ligne: TTOT(1) = TOTAL
' ML = 15 ' pour mise au point
NIV22:
If ligne >= LigneFin Then GoTo NIV225 ' on est au bout
TAux(1) = TAux(1) + 1
ligne = ligne + 1: Morceau = Cells(ligne, 11)
CHUTE = LongueurBarres - TOTAL - Morceau
If CHUTE < 0 Then GoTo NIV22
' donc le morceau tient dans la chute
Noeud = Noeud + 1: TNoeud(Noeud) = ligne
TOTAL = TOTAL + Morceau: TTOT(Noeud) = TOTAL
' pour mise au point
' ML = ML + 1: For J = 1 To Noeud: Cells(ML, J + 2) = TNoeud(J): Next J
' Cells(ML, 1) = Taux(1)
If CHUTE >= DernierMorceau Then GoTo NIV22
NIV225:
AERR = "NIV225:"
' sécurité = limitateur de bouclage
If TAux(1) > TAux(3) Then
TAux(3) = 2 * TAux(3)
End If
' fin de la sécurité
TAux(1) = TAux(1) - Noeud + 1
If CHUTE < 0 Then CHUTE = LongueurBarres - TTOT(Noeud): Indic = 1
If CHUTE < AncienneChute Then
For N = 1 To Noeud: TSol(N) = TNoeud(N): Next N
NoeudSol = Noeud: TAux(2) = TAux(2) + 1
AncienneChute = CHUTE
End If
If CHUTE <= ChuteAcceptable Then
Call Report(TSol, NoeudSol, LigneReport, NombreBarres, LongueurBarres, LigneFin, TAux)
GoTo NIV2
End If
' est-on est au bout de cette branche ?
' plus exactement, peut on remplacer le dernier morceau par 2 plus petits
If ligne < LigneFin - 1 And Morceau > DernierMorceau Then
Indic = 0: GoTo NIV22
End If
If Indic = 1 Then Noeud = Noeud + 1: Indic = 0
TNoeud(Noeud) = LigneFin
NIV23:
AERR = "NIV23:"
If Noeud <= 2 Then GoTo NIV25
LigneNM1 = TNoeud(Noeud - 1): ligne = TNoeud(Noeud)
If ligne - LigneNM1 = 1 Then
Noeud = Noeud - 1: GoTo NIV23
End If
' Donc, il y a un intervalle, entre les 2 noeuds ...
Morceau = Cells(LigneNM1, 11)
If Morceau = Cells(ligne - 1, 11) Then
' ... Mais c'est partout la même valeur
Noeud = Noeud - 1: GoTo NIV23
End If
' ... y'a une dimension différente entre les 2 noeuds
' Donc, on la cherche et on continue
Noeud = Noeud - 2: ligne = LigneNM1
NIV24:
If Cells(ligne + 1, 11) = Morceau Then ligne = ligne + 1: GoTo NIV24
TAux(1) = TAux(1) + Noeud
TOTAL = TTOT(Noeud): GoTo NIV22
' On a fini par détecter la meilleure solution, pour ce 1er morceau
NIV25:
AERR = "NIV25:"
Call Report(TSol, NoeudSol, LigneReport, NombreBarres, LongueurBarres, LigneFin, TAux)
GoTo NIV2
NIVERR:
Mess1 = "Anomalie non prévue détectée dans la macro" + Chr$(10) + "Contacter l'auteur"
MsgBox Mess1, vbOKOnly, Mess0
GoTo FINAL
NIVERR1:
MsgBox "Données anormales", vbOKOnly, Mess0
GoTo FINAL
NIVERR2:
' on vient ici depuis § NIV1:
' si N > 300 ' on peut augmenter la taille des DIM
MsgBox "Limite de 300 formats dépassée", vbOKOnly, Mess0
GoTo FINAL
NIVERR3:
' si LigneFin > 1000 ' on peut augmenter la limite de 1000, mais
' attention au nombre de noeuds
MsgBox "Limite de 1000 morceaux dépassée", vbOKOnly, Mess0
GoTo FINAL
NIVERR4:
Cells(N, 1).Activate
MsgBox "Morceau > Longueur des Barres", vbOKOnly, Mess0
GoTo FINAL
FINAL:
MessF = "Travail non fait"
FINI:
' ActiveSheet.PageSetup.PrintArea = "$A$1:$F" & LigneReport
Cells(4, KK + 7) = MessF
End Sub
Sub Report(TSol, NoeudFin, LigneReport, NombreBarres, LongueurBarres, LigneFin, TAux)
' reporte la solution d'une barre dans les colonnes Résultat C-D-E
KC = 3: KD = KC + 1: KE = KC + 2: KF = KC + 3: KG = KC + 4 ' colonnes report
KK = 9 ' colonne cumuls. Le même que dans Découpe( )
cumul = 0
For LL = 1 To NoeudFin
LigneM = TSol(LL): LongM = Cells(LigneM, 11)
LigneReport = LigneReport + 1
Cells(LigneReport, KC) = LongM: cumul = cumul + LongM
Cells(LigneReport, KD) = Cells(LigneM, 12)
Next LL
Cells(LigneReport, KE) = cumul ' longueur utilisée
Cells(LigneReport, KF) = LongueurBarres - cumul ' chute
Cells(LigneReport, KG) = LongueurBarres
Cells(LigneReport, KG + 1) = TAux(1)
If TAux(2) > 1 Then Cells(LigneReport, KG + 2) = TAux(2) - 1
Cells(5, KK + 6) = Cells(5, KK + 6) + TAux(1): TAux(1) = 0: TAux(2) = 0
' suppression des morceaux utilisés de la colonne K
For LL = NoeudFin To 1 Step -1: LigneM = TSol(LL)
Range("K" & LigneM).Activate: Selection.Delete shift:=xlUp
Range("L" & LigneM).Activate: Selection.Delete shift:=xlUp
LigneFin = LigneFin - 1: TSol(LL) = 0
Next LL
NombreBarres = NombreBarres + 1: Cells(3, KK + 6) = NombreBarres
End SubJ'ai pour projet de réaliser un fichier Excel qui permet d'insérer un fichier .csv qui comprend toute les barres dont j'ai besoin puis, d'automatiquement optimiser la découpe des barres en fonction d'une seule longueur.
J'ai bien avancé sur ce projet, un formulaire s'ouvre à l'ouverture du fichier et je peux sélectionner mon .csv puis celui-ci est insérer dans une feuille puis les données de longueurs et de quantités sont copiées dans une autre feuille.
Désormais je bloque au niveau de l'optimisation. J'ai la volonté de réaliser ce type de macro, le problème étant que je ne comprend pas le fonctionnement de la macro et je n'ai pas envie de simplement copier-coller le code existant dans mon projet, j'ai la réelle envie de comprendre comment faire.
Je vous remercie d'avance pour votre aide.
Bonne journée.
