Aide macro de fichier machine

[ted1057]

Bonjour à tous,

Je travaille, actuellement, sur le développement d'un fichier qui à partir d'une optimisation de débit de lames, je cherche à créer 2 fichiers de débits machine. Un par paquet de 10 / 6 ou 2 et un autre par lame unitaire. Dans mon exemple, je travaille sur des paquets de 10 lames.

Un exemple sera plus parlant qu'un long discours :
exemple de décomposition : 93x [ 2x1974 / 1x1254]
=> j'obtiens 9 fois le résultat ci-dessous
Lame10 / 2 / 1974
Lame10 / 1 / 1254
=> + 3 fois le résultat ci-dessous (lames unitaires)
Lame1 / 2 / 1974
Lame1 / 2 / 1974
Lame1 / 2 / 1974
Lame1 / 1 / 1254
Lame1 / 1 / 1254
Lame1 / 1 / 1254

or je souhaiterai obtenir le résultat suivant pour les lames unitaires
Lame1 / 2 / 1974
Lame1 / 1 / 1254
Lame1 / 2 / 1974
Lame1 / 1 / 1254
Lame1 / 2 / 1974
Lame1 / 1 / 1254
qui correspond à l'optimisation de départ

Est ce possible ou pas?

Merci de votre retour.

PS : un fichier joint en exemple

 

[vgendron]

Hello
un exemple avec ce code

Sub DebitLames()
Range("G1").CurrentRegion.ClearContents 'on efface la zone autour de G1

Dim tabloInit() As Variant
Dim TabloTemp() As Variant
Dim tabloFinal() As Variant

tabloInit = Range("A1").CurrentRegion.Value 'on met dans un tabloInit la zone autour de A1
NbLigne = UBound(tabloInit, 1) 'on récupère le nombre de lignes
NbColonne = UBound(tabloInit, 2) 'on récupère le nombre de colonnes

NbLigne10Final = 0
NbLigneUnitFinal = 0

For i = 1 To NbLigne 'pour chaque ligne
    Item = CInt(Application.WorksheetFunction.Substitute(tabloInit(i, 1), "x", "")) 'on récupère le nombre de la colonne A en enlevant le x
    NbLame10 = Int(Item / 10) 'on en déduit le nombre de lame 10 =chiffre des dizaines
    NbLameUnit = Item Mod 10 'et le nombre de lame 1 = chiffre Unité
    NbLigneFinal = NbLigneFinal + NbLame10 + NbLameUnit 'on update le nombre de ligne qu'il y aura au final dans les colonnes G...
Next i

NbLigneActu = 0
   
ReDim TabloTemp(NbLigneFinal, NbColonne) 'on définit un tabloTemp du nombre de ligne final sur Nbcolonne Colonnes
For i = 1 To NbLigne 'on parcourt à nouveau les lignes
    Item = CInt(Application.WorksheetFunction.Substitute(tabloInit(i, 1), "x", ""))
    NbLame10 = Int(Item / 10)
    NbLameUnit = Item Mod 10
    For j = NbLigneActu To NbLame10 + NbLigneActu - 1
        TabloTemp(j, 0) = "10x"
        For m = 1 To NbColonne - 1
            TabloTemp(j, m) = tabloInit(i, m + 1)
        Next m
    Next j
    For k = j To j + NbLameUnit - 1
        TabloTemp(k, 0) = "1x"
        For m = 1 To NbColonne - 1
            TabloTemp(k, m) = tabloInit(i, m + 1)
        Next m
    Next k
    NbLigneActu = k
Next i
   
Range("G1").Resize(NbLigneFinal, NbColonne) = TabloTemp 'on colle le tabloTemp en G1
'tri sur colonne G
Range("G1").Select
ActiveWorkbook.Worksheets("Feuil2").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Feuil2").Sort.SortFields.Add Key:=Range("G1"), _
    SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("Feuil2").Sort
    .SetRange Range("G1").Resize(NbLigneActu, NbColonne)
    .Header = xlNo
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

tabloInit = Range("G1").CurrentRegion.Value 'on redéfinit le tabloInit avec les données en G1
NbLigne = UBound(tabloInit, 1)
NbColonne = UBound(tabloInit, 2)

Nbfinal = WorksheetFunction.CountA(Range("G1").CurrentRegion.Offset(0, 1))
ReDim TabloTemp(Nbfinal, 3)
k = 0
For i = 1 To NbLigne
    For j = 2 To NbColonne
        TabloTemp(k, 0) = "Lame" & WorksheetFunction.Substitute(tabloInit(i, 1), "x", "")
        If tabloInit(i, j) <> "" Then
             t = Split(tabloInit(i, j), "x")
             TabloTemp(k, 1) = t(0)
             TabloTemp(k, 2) = t(1)
             k = k + 1
        End If
       
    Next j
Next i

Range("N3").Resize(Nbfinal, 4) = TabloTemp 'on colle le résultat en N3
End Sub

 

[ted1057]

Bonjour Vgendron,

Je te remercie du code proposé, je viens d'effectuer quelques test et cela fonctionne très bien.
Je te remercie bien. Je vais regarder pour adapter le code pour mes autres cas.

Cordialement,