Compter des plages de cellule variable
D
Bonsoir à tous,
Merci de jeter un œil dans le fichier joint... RESULTAT.xlsx
Il s'agit de résultat effectué sur Excel+VBA pour optimiser des panneaux ((Ligne 2 à 6) dans un panneau de 2500 mm de long on peut mettre 3 modules de 674 + 1 module de 374 + 1 module de 104).
Chaque ligne est faite par une mise en forme conditionnelle.
Bien sûr le nombre de module dans un panneau peut varier en fonction des demandes de coupes ! (Comme dans le 4ème panneau).
Actuellement j'utilise une formule matricielle =SI(D6="";"";NB.SI.ENS(D:D;D6;C:C;C6)) qui fonctionne en partie les critères ne sont pas adaptés, car par exemple le 2ème et 3ème panneaux sont comptés comme égaux (cause les critères) alors qu'ils ne le sont pas.
Tous ça pour obtenir une feuille de synthèse pour découpe pour un atelier( Exemple: 10 panneaux comme le N°1, 3 panneau comme le N°2, etc...) . sachant qu'il peut y avoir 8000 lignes.
Merci de m'aider à trouver une solution Excel ou +VBA
Hummm
Excel + CBA avec un fichier joint au format xlsX ?
plus de VBA alors
Bonsoir,
veuillez joindre un fichier avec du VBA soit une extension de la forme xlsM, merci
@ bientôt
LouReeD
D
Bonsoir quel rapidité !
Il s'agit d'un code que j'ai adapter pour moi avec des difficultés sans jamais avoir pratiquer le VBA !
Ce qui permet d'avoir ce résultat est...
' Optim 2015
Dim K1 As Integer, K2 As Integer, K3 As Integer, K4 As Integer, n As Integer, k As Integer
Dim TVAL(8000) As Long, TQ(8000) As Long, TLib(8000) As String ' dim 8000
Dim TSol(8000) As Long ' Solution pour la barre étudiée ' Dim 8000
Dim TNoeud(8000) As Integer ' N° de ligne du Noeud étudié
Dim TTOT(8000) 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écoupe35V()
' 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
' 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_35V
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 > 101 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 8000 ' sécurité
TVAL(n) = Empty: TQ(n) = Empty: TLib(n) = Empty
Next n
' report dans la feuille Travail_35V
Sheets("Travail_35V").Select
Cells(4, KK + 1) = "Recherche en cours"
Cells(6, KK) = NomFeuille
Columns("A:B").Select: 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 > 8000 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)
Next k
Next n
Cells(2, KK) = LigneFin - LigneDébut + 1
'1-3) Tri
Columns("A:B").Select
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").Copy
Columns("K").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Cells(1, 11) = ""
'1-5) Vidage de l'ancienne solution, colonnes C-D-E-F
Range("C1:H1").Select
Selection.Cut Destination:=Range("AC1:AH1")
Columns("C:H").Select
Selection.ClearContents
Range("AC1:AH1").Select
Selection.Cut Destination:=Range("C1:H1")
NombreBarres = 0: Cells(3, KK) = NombreBarres
'1-6) tableaux de travail_35V
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) = 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").Select: 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
Mess2 = "Il y a déjà " & TAux(1) & " solutions testées" + Chr$(10) + "Voulez vous continuer"
Réponse = MsgBox(Mess2, vbYesNo, Mess0)
If Réponse <> 6 Then
Cells(5, KK) = Cells(5, KK) + TAux(1)
MessF = "Travail Interrompu": GoTo FINI
End If
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 > 101 ' on peut augmenter la taille des DIM
MsgBox "Limite de 100 formats dépassée", vbOKOnly, Mess0
GoTo FINAL
NIVERR3:
' si LigneFin > 8000 ' on peut augmenter la limite de 8000, mais
' attention au nombre de noeuds
MsgBox "Limite de 8000 morceaux dépassée", vbOKOnly, Mess0
GoTo FINAL
NIVERR4:
Cells(n, 1).Select
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 + 1) = MessF
End SubPardon, j'ai oublié la fin du code...
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 ' 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
Next LL
Cells(LigneReport, KD) = Cumul ' longueur utilisée
Cells(LigneReport, KE) = LongueurBarres - Cumul ' chute
Cells(LigneReport, KF) = LongueurBarres
Cells(LigneReport, KF + 1) = TAux(1)
If TAux(2) > 1 Then Cells(LigneReport, KF + 2) = TAux(2) - 1
Cells(5, KK) = Cells(5, KK) + 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).Select: Selection.Delete Shift:=xlUp
LigneFin = LigneFin - 1: TSol(LL) = 0
Next LL
NombreBarres = NombreBarres + 1: Cells(3, KK) = NombreBarres
End SubBonsoir,
le code dans un fichier serait le bien venu...
Ceci dit, je vous avoue m'être perdu dans le code...
Désolé.
@ bientôt
LouReeD