Microsoft 365 Vba Démultiplication de ligne suivant différentes valeurs

[akira21]

Bonjour,

J'aimerai savoir s'il était possible de démultiplier des lignes suivant plusieurs valeurs qui sont dans ce tableau



Exemple, j'ai une ligne avec en colonne "E" une quantité de 150 ayant pour valeur en "A" "Bouteille" puis en "C" "80x120"

Ma quantité "Max" prévu pour ces valeurs ( Bouteille et 80x120 ) est de "33" (cf Tableau ci-dessus)

J'aimerai donc avoir comme résultat 150/33= 4 lignes ayant une quantité de "33" puis une 5eme ligne avec le restant de la quantité ( 18 )

Je joins un fichier que j'ai renseigné pour mieux comprendre le problème et le résultat voulu.

Je remercie d'avance celui oui celle qui pourra m'aider

Avant :


Après :

 

[akira21]

J'ai trouvé ce code que j'aimerai adapté à mon fichier si ça peut aider.

Sauf que au lieu d'avoir comme seul critère la constante "33", j'ai besoin d'avoir les variables du petit tableau

Sub Transform()

Const M As Integer = 33

Dim LastLig As Long, i As Long

Dim Q As Integer, N As Integer



Application.ScreenUpdating = False



Worksheets("Final").Range("A1:H5000").ClearContents



With Worksheets("Final")

    .UsedRange.Clear

    Worksheets("Restant Prod").UsedRange.Copy .Range("A1")

    LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row

    For i = LastLig To 2 Step -1

        Q = .Range("E" & i).Value

        If Q > M Then

            N = (Q - 1) \ M

            .Range("E" & i).Value = M

            .Rows(i).Copy

            .Rows(i).Resize(N).Insert

            Application.CutCopyMode = False

            .Range("E" & i) = Q - M * N

        End If

    Next i

End With

End Sub

 

[Hasco]

Bonjour,

Comme vous êtes sous excel 365, voici une proposition pas power query après transformation de vos tableaux en tableaux structurés, l'un nommé 'T_Max' et l'autre 'T_Prod'.

Dans la feuille 'Power Query' vous trouverez le tableau résultat du traitement et vos données attendues, pour vérification et comparaison. Tout semble ok.

Cordialement

 

[mapomme]

Bonsoir à tous,

Par VBA. Le code est dans module1. Cliquez sur le bouton Hop!
(Les deux tableaux ont été transformés en tableaux structurés).

Sub duplication()
Dim tsData As ListObject, tsQte As ListObject
Dim min&, som&, max&, td, tq, nfois, nlig&, i&, j&, k&

With Worksheets("Restant Prod")
   Set tsData = .Range("a1").ListObject: Set tsQte = .Range("k1").ListObject
   td = tsData.DataBodyRange.Value: tq = tsQte.DataBodyRange.Value
   min = Application.min(tsQte.DataBodyRange.Columns(3))
   som = Application.Sum(tsData.DataBodyRange.Columns(5).Value)
   max = som / min + tsData.DataBodyRange.Rows.Count
   ReDim res(1 To max, 1 To UBound(td, 2))
 
   For i = 1 To UBound(td)
      max = td(i, 5)
      For k = 1 To UBound(tq)
         If td(i, 1) = tq(k, 1) And td(i, 3) = tq(k, 2) Then max = tq(k, 3)
      Next k
      nfois = Int(td(i, 5) / max)
      For k = 1 To nfois
         nlig = nlig + 1
         For j = 1 To UBound(td, 2): res(nlig, j) = td(i, j): Next
         res(nlig, 5) = max
      Next k
      If max * nfois <> td(i, 5) Then
         nlig = nlig + 1
         For j = 1 To UBound(td, 2): res(nlig, j) = td(i, j): Next
         res(nlig, 5) = td(i, 5) - max * nfois
      End If
   Next i
   tsData.ListColumns(1).Range(2, 1).Resize(nlig, UBound(td, 2)) = res
End With
End Sub

 

[akira21]

Bonsoir à tous,

Par VBA. Le code est dans module1. Cliquez sur le bouton Hop!
(Les deux tableaux ont été transformés en tableaux structurés).

Sub duplication()
Dim tsData As ListObject, tsQte As ListObject
Dim min&, som&, max&, td, tq, nfois, nlig&, i&, j&, k&

With Worksheets("Restant Prod")
   Set tsData = .Range("a1").ListObject: Set tsQte = .Range("k1").ListObject
   td = tsData.DataBodyRange.Value: tq = tsQte.DataBodyRange.Value
   min = Application.min(tsQte.DataBodyRange.Columns(3))
   som = Application.Sum(tsData.DataBodyRange.Columns(5).Value)
   max = som / min + tsData.DataBodyRange.Rows.Count
   ReDim res(1 To max, 1 To UBound(td, 2))
 
   For i = 1 To UBound(td)
      max = td(i, 5)
      For k = 1 To UBound(tq)
         If td(i, 1) = tq(k, 1) And td(i, 3) = tq(k, 2) Then max = tq(k, 3)
      Next k
      nfois = Int(td(i, 5) / max)
      For k = 1 To nfois
         nlig = nlig + 1
         For j = 1 To UBound(td, 2): res(nlig, j) = td(i, j): Next
         res(nlig, 5) = max
      Next k
      If max * nfois <> td(i, 5) Then
         nlig = nlig + 1
         For j = 1 To UBound(td, 2): res(nlig, j) = td(i, j): Next
         res(nlig, 5) = td(i, 5) - max * nfois
      End If
   Next i
   tsData.ListColumns(1).Range(2, 1).Resize(nlig, UBound(td, 2)) = res
End With
End Sub

Bonsoir et un grand merci pour votre aide

Le fonctionnement est au top sauf que je rencontre un problème si des lignes sont vides dans le tableau.

Tant que le tableau fait la même taille que les données pas de problème mais ce tableau est amené par la suite à vivre et donc il n'aura pas forcément la même taille à chaque fois

Savez vous comment régler le problème ? :/

Edit : Le tableau gardera toujours la même largeur mais la hauteur changera !

 

[akira21]

Bonjour,

Comme vous êtes sous excel 365, voici une proposition pas power query après transformation de vos tableaux en tableaux structurés, l'un nommé 'T_Max' et l'autre 'T_Prod'.

Dans la feuille 'Power Query' vous trouverez le tableau résultat du traitement et vos données attendues, pour vérification et comparaison. Tout semble ok.

Cordialement

Bonsoir, je vous dit aussi un grand merci pour votre aide

Je vous avoue que je n'avais jamais pensé que c'était possible de le réaliser en Power Query !
On en apprend tous les jours donc merci pour ça

Je rencontrais le même problème qu'au dessus, si le tableau source change de taille cela me mettait une erreur.
J'ai réglé le problème simplement en filtrant ( déchochant ) Null dans la 1ere colonne

Au final, l'idéal serait d'avoir cela en VBA car cela va s'implémenter avec d'autres macros, mais je vais tout de même voir comment je peux combiner mon travail avec votre solution car elle est très intéressante

Encore merci à vous

 

[mapomme]

Edit : Le tableau gardera toujours la même largeur mais la hauteur changera !

Mon code s'adapte aux nombre de lignes des deux tableaux structurés.

Je n'ai pas prévu le cas où il y aurait des lignes car une base de données ne doit pas avoir de lignes vides (c'est un non sens).
Donc mon code aboutit à une erreur à la première ligne vide puisqu'il tente une division par une quantité qui est nulle.

 

[akira21]

Bonjour,
Je comprends, une solution peut être serait de redimensionner le tableau en fonction des données qu'il y a dedans ?
J'ai ce code qui fonctionne si j'ajoute des données au tableau mais l'inverse non

Sub Redim_tableau()
Dim Bottom As Long
 With Worksheets("Structure Restant Prod").ListObjects("tbTM1")
        Bottom = .Parent.Range(Split(.Range.Address, "$")(1) & Rows.Count).End(xlUp).Row    'dernière ligne
        .Resize .Range.Range(Cells(1), Cells(Bottom - .Range.Cells(1).Row + 1, .ListColumns.Count)) 'on redimensione
    End With

End Sub

 

[Hasco]

Bonjour,
p

Je rencontrais le même problème qu'au dessus, si le tableau source change de taille cela me mettait une erreur.

un tableau structuré, change sa taille automatiquement, il n'est pas besoin de le redimensionner.
C'est pourquoi, il ne faut pas laisser de lignes vides, non seulement, cela ne sert à rien, mais en plus cela complique toujours les opérations( de quelque nature qu'elles soient).

D'ailleurs en VBA (votre dernier post) il n'est pas besoin de toutes ces lignes pour récupérer la plage du tableau. Sa propriété .DataBodyRange renvoie un objet Range représentant le corps du tableau

voyez le tuto ci-dessous :

Excel: Les tableaux structurés en VBA

Excel: Les tableaux structurés en VBA

fauconnier.developpez.com

Au final, l'idéal serait d'avoir cela en VBA car cela va s'implémenter avec d'autres macros,

Il est possible de demander le rafraîchissement d'une requête par macro.

Cordialement

 

[akira21]

Ok je comprends et donc je dois sûrement modifier ma macro du tableau source pour que cela fonctionne avec un tableau structuré.

Si j'actionne cette macro, les données s'ajoutent à la ligne après le tableau et le tableau s'agrandit mais tout en laissant les données en bas.

Il n'est pas censé avoir de ligne vide mais simplement que je prenais le problème à l'envers. C'est à dire avoir la bonne manière pour intégrer les données au tableau structuré.

Savez vous comment je pourrais régler le problème ?

Encore merci pour votre aide

Sub Test_Restant_Prod_sans_bloc1_2()

Dim i As Integer, dlg As Integer
Dim ws1 As Worksheet, ws2 As Worksheet
Application.ScreenUpdating = False

Set ws1 = Sheets("Cockpit")
Set ws2 = Sheets("Test")

Worksheets("Test").Range("E2:L5000").ClearContents

With ws1

For i = 6 To .Range("A" & Rows.Count).End(xlUp).row
        If .Cells(i, 9) < 0 And .Cells(i, 1) <> "Bloc 1" And .Cells(i, 1) <> "Bloc 2" Then
            dlg = ws2.Range("E" & Rows.Count).End(xlUp).row + 1
            If .Range("B" & i) = .Range("B" & i + 1) Then GoTo suite
            'Ligne
            ws2.Range("E" & dlg) = .Range("A" & i)
            'Code
            ws2.Range("F" & dlg) = .Range("B" & i)
            'Date Prod
            ws2.Range("K" & dlg) = .Range("D" & i)
            'Quantité produite
            ws2.Range("I" & dlg) = .Range("I" & i) * -1
            'Entrée Prod Restante
            ws2.Range("L" & dlg) = "Entrée Prod Restante"
        End If
suite:
    Next i
End With


End Sub

 

[Hasco]

Re,

Dans le fichier joint, vous trouverez une macro que j'ai nommée 'Filtrer' pour conserver la votre.



Cordialement

 

[akira21]

Bonjour Hasco,

Je viens juste de voir votre réponse et je m'excuse pour le doublon
Je vous remercie grandement pour votre aide précieuse que vous m'apportez et encore désolé pour cette erreur de jugement

Concernant le fichier, je vous remercie, c'est vraiment top. Grâce à vous, j'avance et j'apprend

 

[akira21]

Je me heurte de nouveau à un problème. Je suis désolé de vous dérangez
Quand j'utilise une 1ere fois la macro "Decouplage", cela fonctionne correctement.
Ensuite je mets à jour le tableau du milieu avec la macro "Test_Restant_Prod_sans_bloc1_2", puis la macro "Découplage", j'ai cette erreur "incompatibilité de type" sur :

n = n + dico.Item(tbProd(i, 2))(0)

Savez vous d'où cela peut venir ?

 

[Hasco]

Re :

C'est ce qui arrive quand on picore des morceaux de codes et solutions à droite et à gauche sans comprendre ce qu'on fait. C'est le genre de chose qui mène tout droit vers une belle usine à gaz.

Cela ne m'incite pas à poursuivre, passe donc mon chemin

 

[akira21]

Désolé, je comprends votre réaction
N'ayant pas de connaissance en vba et tableau structuré, je n'imaginais pas les problèmes que j'aurai eu.
Merci tout de même pour votre grande aide et je compte bien regarder votre lien sur les tableaux