XL 2019 Optimisation de longueur de barre en long multiple

Ryoken

XLDnaute Nouveau
Bonjour la communauté,

J'ai vraiment besoin de votre aide. Je travail depuis plusieurs mois sur un projet, et j'ai fait beaucoup de recherche, sans succès.

J'ai récupérer une macro d'optimisation de coupe de barre de Jean Dupra, qui a fait un très bon travail.
J'ai déjà pu l'adapter à certains de mes besoins. Toutefois, ce que j'ai trouvé ne permet d'optimiser que sur une longueur fixe.

Moi, j'aurais besoin d'optimiser sur deux type de longueur, avec un gestion de quantité disponible par chaque longueur.
Nous travaillons essentiellement avec des barres en bois de 13 et 6.5 ml.

Je vous joins mon code actuel ci-dessous, qui est assez complexe.
En espérant avoir susciter votre curiosité, je vous remercie d'avance pour votre aiguillage et conseils



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 Sub
 

Ryoken

XLDnaute Nouveau
Bonjour,

Voici le fichier en annexe de base, sans toutes les éventuelle modification et essai que j'ai fait sur ce thème, sinon ca serait encore moins clair.

Alors ce que j'aimerai faire, c'est pouvoir entrer les quantités de barre en stock sur la feuil "demande" en cellules (F2:F3)

Ensuite je dois modifier la macro et c'est là que j'ai besoin d'aide. Pour que ca calcule avec x barres en longueur 650cm et le reste en longueur 1300cm, en fonction des stocks disponibles de chaque longueur.

Après ca, ca doit aussi reporter sur la feuil "travail" dans les cellules (I3:I4) le résultat des quantités utilisées par longueur, sans dépasser les quantités de stock.

J'espère avoir été plus clair et n'hésitez pas à me redemander si besoin de plus amples informations

Merci d'avance pour vos propositions ou aiguillage
 

Pièces jointes

  • Optimisateur Dimter.xlsm
    46.6 KB · Affichages: 54

Discussions similaires

Réponses
8
Affichages
620