décomposition de quantités par paquets

surgeon84fr

surgeon84fr

XLDnaute Junior
Bonjour,

je joints d'office mon fichier car l'explication risque de ne pas etre claire.

Je cherche un moyen simple pour faire une décomposition par paquets de 10 de quantités de matériels.

Je m'explique:

dans ma colonne 1, il y a des codes d'entités.
dans ma colonne 2 , il y a des quantités associées à des types de matériels, qui sont , eux dans la colonne 3.

concretement:
pour l'entité 01E0000, j'ai un total de 14 matériels. Il faut donc décomposer en une ligne de 10 et une ligne de 4, soit 2 lignes pour cette entité.
On passe à l'entité 013E000, j'ai un total de 103 matériels que je dois décomposer en 10 lignes identiques de 10 matériels et une ligne de 3, soit 11 lignes pour cette entité.

etc. pour chaque ligne en fonction du code de l'entité et du total de matériels concernés.

Je vous remercie d'avance pour vos éclairs de génie!!
 

Pièces jointes

  • a decomposer.xlsm
    74.3 KB · Affichages: 38
Trier par date Trier par votes
KenDev

KenDev

XLDnaute Impliqué
Re : décomposition de quantités par paquets

Bonsoir surgeon,

A tester.

Cordialement
KD

VB: 
Sub Decomp()
    Dim a(), b&, i&, c&, j%, d%, w As Worksheet
    b = Cells(Rows.Count, 1).End(xlUp).Row
    If b > 1 Then
        ReDim a(1 To b, 1 To 2): c = 1
        For i = 2 To b
            If Cells(i, 1) = a(c, 1) Then
                a(c, 2) = a(c, 2) + Cells(i, 2)
            Else
                c = c + 1
                For j = 1 To 2: a(c, j) = Cells(i, j): Next j
            End If
        Next i
        Set w = ActiveSheet
        Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
        Sheets.Add: Columns(1).NumberFormat = "@": d = 1
        For i = 2 To c
            b = a(i, 2)
            Do While b > 0
                d = d + 1
                If b > 9 Then Cells(d, 2) = 10 Else Cells(d, 2) = b
                b = b - 10: Cells(d, 1) = a(i, 1)
            Loop
        Next i
        For i = 1 To 2: w.Cells(1, i).Copy Destination:=ActiveSheet.Cells(1, i): Next i
        Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
    End If
End Sub
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : décomposition de quantités par paquets

Bonsoir surgeon, Kendev,

Voyez le fichier joint et cette macro :

Code: 
Sub Décomposé()
Dim t1, t2(), i&, n&, x$, y$, j&
t1 = Sheets("A COMPLETER").[A1].CurrentRegion
ReDim t2(1 To Sheets("Décomposé").Rows.Count - 1, 1 To 3)
For i = 2 To UBound(t1)
  n = Int(t1(i, 2) / 10)
  x = t1(i, 1): y = t1(i, 3)
  For j = j + 1 To j + n
    t2(j, 1) = x
    t2(j, 2) = 10
    t2(j, 3) = y
  Next
  t2(j, 1) = x
  t2(j, 2) = t1(i, 2) - 10 * n
  t2(j, 3) = y
Next
With Sheets("Décomposé")
  If j Then .[A2].Resize(j, 3) = t2
  .Range("A" & j + 2 & ":C" & .Rows.Count).ClearContents
  .Activate
End With
End Sub
Noter que dans les 2 feuilles les bordures sont appliquées par MFC sur A:C.

A+
 

Pièces jointes

  • A décomposer(1).xls
    326 KB · Affichages: 34
Vote positif 0 Vote négatif
surgeon84fr

surgeon84fr

XLDnaute Junior
Re : décomposition de quantités par paquets

Rebonjour.

je reviens vers vous comme promis. Et encore merci d'avance pour votre précieuse aide.

Les 2 macros ont l'air de faire ce que j'ai effectivement décrit.

Pour Kendev, il manque la recopie de la troisième colonne avec le matériel concerné dans les paquets de 10. Sinon, le découpage fonctionne bien.

Pour jo75, il manquait juste la mise en forme de la première colonne pour qu'elle conserve le même format. En effet, à l'éxécution, le "E" premier code est assimilé à la fonction "EXPOSANT".Sinon la recopie dse 3 colonne décomposées fonctionne bien.

Du coup, je remets en PJ le vrai fichier que j'avais épuré des colonnes inutiles. J'ai vidé les contenus.
En réalité, on ne sait jamais à l'avance combien il y aura de lignes, et il se peut aussi que le nombre de colonnes change. Enfin, je ne sais pas à l'avance si la colonne TYPE et QUANTITE resteront à la même place avec les différentes version de cet outil.

Avec ces hypothèses, serait-il possible d'adapter vos macros?

Bien cordialement
 

Pièces jointes

  • a décomposer.xlsm
    270.2 KB · Affichages: 22
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : décomposition de quantités par paquets

Bonjour surgeon,

surgeon à dit:
Pour jo75, il manquait juste la mise en forme de la première colonne pour qu'elle conserve le même format.
Cliquez pour agrandir...

Il n'y a aucune raison de faire faire cela par la macro.

La feuille "Décomposé" doit être créée et mise en forme manuellement avant de lancer la macro avec :

- les titres en 1ère ligne

- La colonne A au format texte

- la MFC sur A:C pour les bordures

- le quadrillage non affiché.

Je regarde pour les autres questions.

A+
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : décomposition de quantités par paquets

Re,

Voir ce fichier (2) avec cette macro :

Code: 
Sub Décomposé()
Dim t#, derlig&, dercol%, t1, colref%, t2(), i&, n&, a, j&, k%
t = Timer 'facultatif, pour chronométrer
With Sheets("A COMPLETER")
  derlig = .Cells(.Rows.Count, 1).End(xlUp).Row
  dercol = .Cells(2, .Columns.Count).End(xlToLeft).Column
  t1 = .[A1].Resize(derlig, dercol)
  colref = Application.Match("QUANTITE", .[2:2], 0)
End With
ReDim t2(1 To Sheets("Décomposé").Rows.Count - 1, 1 To dercol)
For i = 3 To derlig
  n = Int(t1(i, colref) / 10)
  a = Application.Index(t1, i, 0) 'tableau mémorisé
  For j = j + 1 To j + n
    For k = 1 To dercol
      t2(j, k) = a(k)
    Next
    t2(j, colref) = 10
  Next
  For k = 1 To dercol
    t2(j, k) = a(k)
  Next
  t2(j, colref) = t1(i, colref) - 10 * n
Next
With Sheets("Décomposé")
  If j Then .[A3].Resize(j, dercol) = t2
  .[A3].Offset(j).Resize(.Rows.Count - j - 2, dercol).ClearContents
  .Activate
End With
MsgBox "Durée " & Format(Timer - t, "0.0 \s")
End Sub
Sur Excel 2003 la durée d'exécution est de 56 secondes.

C'est un peu long, malgré les tableaux VBA, c'est dû au nombre de colonnes (26).

Noter que la MFC est appliquée sur toutes les cellules des 2 feuilles.

A+
 

Pièces jointes

  • A décomposer(2).xls
    614.5 KB · Affichages: 30
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : décomposition de quantités par paquets

Re,

surgeon à dit:
Il y a juste une chose bizarre:

pour toutes les quantités multiples de 10, ça me rajoute une ligne supplémentaire à 0.
Cliquez pour agrandir...

Ah oui bien vu, je n'avais pas testé ce cas :rolleyes:

Il suffit de remplacer :

Code: 
t2(j, colref) = t1(i, colref) - 10 * n
par :

Code: 
If t1(i, colref) Mod 10 Then t2(j, colref) = t1(i, colref) Mod 10 Else j = j - 1
La macro corrigée :

Code: 
Sub Décomposé()
Dim t#, derlig&, dercol%, t1, colref%, t2(), i&, n&, a, j&, k%
t = Timer
With Sheets("A COMPLETER")
  derlig = .Cells(.Rows.Count, 1).End(xlUp).Row
  dercol = .Cells(2, .Columns.Count).End(xlToLeft).Column
  t1 = .[A1].Resize(derlig, dercol)
  colref = Application.Match("QUANTITE", .[2:2], 0)
End With
ReDim t2(1 To Sheets("Décomposé").Rows.Count - 1, 1 To dercol)
For i = 3 To derlig
  n = Int(t1(i, colref) / 10)
  a = Application.Index(t1, i, 0) 'tableau mémorisé
  For j = j + 1 To j + n
    For k = 1 To dercol
      t2(j, k) = a(k)
    Next
    t2(j, colref) = 10
  Next
  For k = 1 To dercol
    t2(j, k) = a(k)
  Next
  If t1(i, colref) Mod 10 Then t2(j, colref) = t1(i, colref) Mod 10 Else j = j - 1
Next
With Sheets("Décomposé")
  If j Then .[A3].Resize(j, dercol) = t2
  .[A3].Offset(j).Resize(.Rows.Count - j - 2, dercol).ClearContents
  .Activate
End With
MsgBox "Durée " & Format(Timer - t, "0.0 \s")
End Sub
Fichier (3).

Nota : j'ai testé sur Win 7 - Excel 2010, la macro s'exécute en 33 ou 34 secondes sur fichiers .xls ou .xlsm.

A+
 

Pièces jointes

  • A décomposer(3).xls
    614.5 KB · Affichages: 19
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : décomposition de quantités par paquets

Re,

Bon ceci est mieux car plus rapide s'il y a beaucoup de quantités multiples de 10 :

Code: 
Sub Décomposé()
Dim t#, derlig&, dercol%, t1, colref%, t2(), i&, n&, a, j&, k%
t = Timer
With Sheets("A COMPLETER")
  derlig = .Cells(.Rows.Count, 1).End(xlUp).Row
  dercol = .Cells(2, .Columns.Count).End(xlToLeft).Column
  t1 = .[A1].Resize(derlig, dercol)
  colref = Application.Match("QUANTITE", .[2:2], 0)
End With
ReDim t2(1 To Sheets("Décomposé").Rows.Count - 1, 1 To dercol)
For i = 3 To derlig
  n = Int(t1(i, colref) / 10)
  a = Application.Index(t1, i, 0) 'tableau mémorisé
  For j = j + 1 To j + n
    For k = 1 To dercol
      t2(j, k) = a(k)
    Next
    t2(j, colref) = 10
  Next
  If t1(i, colref) Mod 10 Then
    For k = 1 To dercol
      t2(j, k) = a(k)
    Next
    t2(j, colref) = t1(i, colref) Mod 10
  Else
    j = j - 1
  End If
Next
With Sheets("Décomposé")
  If j Then .[A3].Resize(j, dercol) = t2
  .[A3].Offset(j).Resize(.Rows.Count - j - 2, dercol).ClearContents
  .Activate
End With
MsgBox "Durée " & Format(Timer - t, "0.0 \s")
End Sub
Fichier (4).
 

Pièces jointes

  • A décomposer(4).xls
    615 KB · Affichages: 23
Vote positif 0 Vote négatif
surgeon84fr

surgeon84fr

XLDnaute Junior
Re : décomposition de quantités par paquets

Merci beaucoup pour ton investissmeent.

Chez moi (au boulot) les deux macro mettent 85s. Ce qui est rien si je devais faire le boulot manuellement.

J'y ai rajouté la création de l'onglet automatiquement et la mise en forme par la macro...mais à fignoler car pas encore parfait.

Merci encore. je vais essayer d'y rajouter ma patte.

Cdlt.

Maintenant
 
Vote positif 0 Vote négatif
surgeon84fr

surgeon84fr

XLDnaute Junior
Re : décomposition de quantités par paquets

Au passage, pourrais-tu m'expliquer la ligne

colref = Application.Match("QUANTITE", .[2:2], 0)
Cliquez pour agrandir...

Et si c'est pas trop abuser, j'aimerais comprendre (par des commentaires ajoutés le fonctionnement.

Car autant je me sui lancé dans certaines macro, autant là, je suis hyper largué dès le départ avec la définition des variables avec des % ou des $.

Merci d'avance
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : décomposition de quantités par paquets

Re,

Application.Match c'est tout simplement la fonction EQUIV des feuilles de calcul.

Les signes # & % définissent les variables As Double, As Long, As Integer.

Pour finir, il n'y a pas à "recréer" la feuille "Décomposé", mais effectivement on peut la mettre en forme, au cas où la mise en forme de la feuille "A COMPLETER" est modifiée.

Simplement en copiant cette feuille :

Code: 
With Sheets("Décomposé")
  Sheets("A COMPLETER").Cells.Copy .[A1] 'copie tout
  .[A2].Copy .[A2] 'vide le presse-papiers
  If j Then .[A3].Resize(j, dercol) = t2
  .Activate
End With
Fichier (5)

Edit : j'ai quand même limité la MFC aux colonnes A:Z.

A+
 

Pièces jointes

  • A décomposer(5).xls
    615.5 KB · Affichages: 33
Dernière édition:
Vote positif 0 Vote négatif
KenDev

KenDev

XLDnaute Impliqué
Re : décomposition de quantités par paquets

surgeon à dit:
...
Pour Kendev, il manque la recopie de la troisième colonne avec le matériel concerné dans les paquets de 10. Sinon, le découpage fonctionne bien...
Cliquez pour agrandir...

Bonjour Surgeon, bonjour Job,

Je reprends le fichier exemple
Ligne 3 : 013E000 99 1A
Ligne 4 : 013E000 14 1B

On arrive a 11 Lignes 013E000 10 et 1 Ligne 013E000 3. Pour la 10ème ligne ou sont vos instructions pour la 3ème colonne qui contiendra donc neuf 1A et un 1B ?...

surgeon à dit:
...
On passe à l'entité 013E000, j'ai un total de 103 matériels que je dois décomposer en 10 lignes identiques de 10 matériels et une ligne de 3, soit 11 lignes pour cette entité.

etc. pour chaque ligne en fonction du code de l'entité et du total de matériels concernés...
Cliquez pour agrandir...

La 3ème colonne n'a donc, logiquement, pas été incluse puisque vous avez préféré garder pour vous le comportement que la macro devait adopter dans les cas ou les types sont mélangés. Les explications fournies laissaient entendre que les informations de la 3ème colonne devenaient caduques.

Cordialement

KD

ps : 99 + 14 = 113
 
Vote positif 0 Vote négatif
surgeon84fr

surgeon84fr

XLDnaute Junior
Re : décomposition de quantités par paquets

Re

Pour KenDev

Tu as raison. Il fallait bien que je me trompe dans mes explications.

En fait si : j'avais besoin de la troisième colonne. C'est le résultat de vos 2 macro à chacun qui m'a fait remarquer le manque dans la tienne.

Désolé pour l'oubli.

Et merci pour ton aide également
 
Vote positif 0 Vote négatif

Discussions similaires

M
  • Résolu(e)
XL 2021 calcul : Somme des quantités de chaque produit à fabriquer
Réponses
3
Affichages
458
MinstrelL
M
S
  • Question
XL 2016 Problème de classement de prix croissants non désiré
Réponses
4
Affichages
378
chris
chris
N
  • Résolu(e)
XL 2021 Power Query somme des fin de journée où il y a juste une heure de commencement ?
2
Réponses
19
Affichages
893
Cousinhub
Cousinhub
B
  • Résolu(e)
XL 2016 Additionner les quantités et supprimer les lignes en trop
Réponses
9
Affichages
1 K
BPM
B
J
  • Question
XL 2016 Mise en forme conditionnelle en vert de noms, si ces noms figurent dans une liste de noms d'un autre onglet (formules dans MFormCond, ou VBA)
Réponses
5
Affichages
588
sylvanu
sylvanu
Cédric L
  • Question
XL 2019 Récupérer des données et les inscrire jour après jour des premières cellules vides de colonne
2
Réponses
29
Affichages
2 K
Cédric L
Cédric L
B
  • Question
Suppression de colonnes
Réponses
14
Affichages
958
job75
job75
L
  • Résolu(e)
XL 2010 Automatiser par VBA la décomposition d'une ligne d'un fichier en 3 lignes sur un autre onglet
Réponses
7
Affichages
1 K
Lordchris
L
O
  • Résolu(e)
XL 2019 Moyenne de valeurs par date à partir d'un tableau
Réponses
4
Affichages
759
Olocsob
O
F
  • Résolu(e)
Microsoft 365 VBA - Masquer un bloc de ligne - Case a cocher
Réponses
5
Affichages
1 K
Faranor
F

Membres actuellement en ligne

4 membres et 69 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 104
Messages
2 085 349
Membres
102 870
dernier inscrit
Armisa