décomposition de quantités par paquets

surgeon84fr · 15 Septembre 2014

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!!

job75 · 16 Septembre 2014

Re : décomposition de quantités par paquets

Re,

Au cas où mon post #13 serait passé inaperçu :

https://www.excel-downloads.com/threads/decomposition-de-quantites-par-paquets.223923/

A+

surgeon84fr · 16 Septembre 2014

Re : décomposition de quantités par paquets

job75 à dit:
Re,

Au cas où mon post #13 serait passé inaperçu :

https://www.excel-downloads.com/threads/decomposition-de-quantites-par-paquets.223923/

A+

Super!!!

Effectivement, je l'ai loupé.... merci du rappel et ça fonctionne parfaitement

Merci beaucoup pour votre aide.

a bientot

job75 · 16 Septembre 2014

Re : décomposition de quantités par paquets

Re,

Cette longue durée d'exécution m'intriguait.

Je pensais que la mémorisation de chaque ligne du tableau dans la variable a faisait gagner du temps.

Or c'est elle qui plombait la macro

Avec ce fichier (6) la durée d'exécution passe à 0,78 seconde (Excel 2003) :

Code:

Sub Décomposé()
Dim t#, derlig&, dercol%, t1, colref%, t2(), i&, n&, 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)
  For j = j + 1 To j + n
    For k = 1 To dercol
      t2(j, k) = t1(i, k)
    Next
    t2(j, colref) = 10
  Next
  If t1(i, colref) Mod 10 Then
    For k = 1 To dercol
      t2(j, k) = t1(i, k)
    Next
    t2(j, colref) = t1(i, colref) Mod 10
  Else
    j = j - 1
  End If
Next
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
MsgBox "Durée " & Format(Timer - t, "0.00 \s")
End Sub

A+

surgeon84fr · 17 Septembre 2014

Re : décomposition de quantités par paquets

Bonjour job75.

Extraordinaire cette différence de temps!!!!!! Bon le PC du boulot n'a pas l'air aussi performant puisque je tourne en 5s....par rapport à 85s, ça le fait bien quand même
Voici ma macro complète.
Malgré tes conseils, j'ai laissé mes rajouts puisque le résultat correspond exactement à ce que je voulais :j'ai 2 colonnes de codes , la 1 et la 5, nécessitant la mise en forme "texte"; de plus, une fois la macro executée, ce texte noir ne rendait pas la lisibilité simple, donc j'ai coloré les intérieurs.
:

Sub Décomposer()

Dim t#, derlig&, dercol%, t1, colref%, t2(), i&, n&, j&, k%

t = Timer 'facultatif, pour chronométrer

' supprime l'onglet "Décomposé" s'il existe
Application.DisplayAlerts = False
If SH_exist("Décomposé") = True Then Sheets("Décomposé").Delete
Application.DisplayAlerts = True

' creation de l'onglet "Décomposé"
Sheets.Add after:=Sheets(Worksheets.Count)
Sheets(Worksheets.Count).Name = "Décomposé"

' reproduit le format de l'onglet "A COMPLETER"
Sheets("A COMPLETER").Select
colcredo = Application.Match("CREDO", Sheets("A COMPLETER").[2:2], 0)
Cells.Select
Range("a1").Activate
Selection.Copy
Sheets("Décomposé").Select
Cells.Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
ActiveWindow.Zoom = 69
Sheets("A COMPLETER").Select
Rows("1:2").Select
Selection.Copy
Sheets("Décomposé").Select
Rows("1:1").Select
ActiveSheet.Paste
Columns(colcredo).NumberFormat = "@"
Columns(colcredo + 4).NumberFormat = "@"
Sheets("A COMPLETER").Select

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)
For j = j + 1 To j + n
For k = 1 To dercol
t2(j, k) = t1(i, k)
Next
t2(j, colref) = 10
Next
If t1(i, colref) Mod 10 Then
For k = 1 To dercol
t2(j, k) = t1(i, 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

'mise en couleur
Application.ScreenUpdating = False

With Sheets("Décomposé")
derlig = .Cells(.Rows.Count, 1).End(xlUp).Row
dercol = .Cells(2, .Columns.Count).End(xlToLeft).Column
End With
Range("a3").Select
col = 3

For d = 3 To derlig
Set cel1 = Range("a" & d)
Range(cel1, ActiveCell.Offset(0, dercol - 1)).Interior.ColorIndex = col
Set cel2 = Range("a" & d + 1)
credo1 = cel1.Value
credo2 = cel2.Value
cel2.Select
If credo1 <> credo2 Then
col = col + 1
Range(cel2, ActiveCell.Offset(0, dercol - 1)).Interior.ColorIndex = col
Else
Range(cel2, ActiveCell.Offset(0, dercol - 1)).Interior.ColorIndex = col
End If
If col = 56 Then col = 3
Next d

Application.ScreenUpdating = True

MsgBox "Durée " & Format(Timer - t, "0.0 \s")

End Sub

Function SH_exist(Nom As String) As Boolean

' test de l'existence d'un onglet

Dim sh As Worksheet

SH_exist = False

For Each sh In Sheets
If sh.Name = Nom Then
SH_exist = True
Exit For
End If
Next

End Function

job75 · 17 Septembre 2014

Re : décomposition de quantités par paquets

Bonjour surgeon,

Aïe aïe aïe mes yeux, tous ces Select, Copy, Past

En VBA il est pratiquement toujours inutile de sélectionner quoi que ce soit.

Et malheureusement l'usine à gaz est le propre des gens peu expérimentés.

Sans rancune et bonne journée.

surgeon84fr · 17 Septembre 2014

Re : décomposition de quantités par paquets

Non sans rancune.

Mais mon inexpérience, ne cache rien à ma volonté d'apprendre!!!! Sinon je ne serais pas venu vous solliciter.

Je sais que VBA est puissant, mais je suis loin de connaitre tous les rouages des automatisations.....

Il se peut que j'ai encore besoin de vos lumières sur mon fichier. Mais en attendant, pourrais-tu juste m'éclairer sur le moyen d'éviter les select et autres copy ou paste?.

Merci d'avance

job75 · 17 Septembre 2014

Re : décomposition de quantités par paquets

Re,

surgeon à dit:
Mais en attendant, pourrais-tu juste m'éclairer sur le moyen d'éviter les select et autres copy ou paste?

C'est simple, regardez à la fin de ma macro comment je copie la 1ère feuille sur la 2ème.

Il n'y a ni Select ni Paste.

Bonne nuit.

surgeon84fr · 18 Septembre 2014

Re : décomposition de quantités par paquets

OK merci

je vais regarder cela.

Bonne continuation.

surgeon84fr · 18 Septembre 2014

Re : décomposition de quantités par paquets

Re

j'ai bien tout regarder au pas par pas. Elle marche nickel cette macro. Vraiment super.

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

Malgré tes commentaires, je ne comprends pas les .[A1], .[A2] et .[A3]

En te remerciant d'avance.

job75 · 18 Septembre 2014

Re : décomposition de quantités par paquets

Bonjour surgeon,

Le point est indispensable, il précise que la feuille est celle indiquée après le With.

Quant aux Copy, Resize ou autres, prenez l'habitude de consulter l'aide VBA.

A+

surgeon84fr · 19 Septembre 2014

Re : décomposition de quantités par paquets

Bonjour job75.

Je vais autant que je peux sur l'aide vba.
En fait, je comprends la forme avec le with et le point.
Ce que je n'ai pas compris, c'est les A1 A2 et A3 entre crochets.
C'est la cellule? Pourquoi A2 vide le presse papier??

Merci pour ta patience.

job75 · 19 Septembre 2014

Re : décomposition de quantités par paquets

Bonjour surgeon,

.[A1] c'est la même chose que .Range("A1")

Le vidage de la mémoire n'est peut-être pas indispensable ici.

J'ai pris l'habitude de le faire sur Excel 2010 quand je copie une feuille entière car parfois il y a un message d'Excel.

A+

surgeon84fr · 19 Septembre 2014

Re : décomposition de quantités par paquets

Parfait

merci bcp

bonne continuation

décomposition de quantités par paquets

surgeon84fr

XLDnaute Junior

Pièces jointes

job75

XLDnaute Barbatruc

surgeon84fr

XLDnaute Junior

job75

XLDnaute Barbatruc

Pièces jointes

surgeon84fr

XLDnaute Junior

job75

XLDnaute Barbatruc

surgeon84fr

XLDnaute Junior

job75

XLDnaute Barbatruc

surgeon84fr

XLDnaute Junior

surgeon84fr

XLDnaute Junior

job75

XLDnaute Barbatruc

surgeon84fr

XLDnaute Junior

job75

XLDnaute Barbatruc

surgeon84fr

XLDnaute Junior

Discussions similaires