Microsoft 365 Transposer des quantitatifs sur une même colonne

[SPOONER]

Bonjour,

J'ai un fichier qui possède des tarifs par palier, avec des quantités différentes.
Pour l'utiliser dans un autre programme, j'aurais besoin de transposer les quantitatifs dans la même colonne que le premier palier en doublon le code article.

Existe-t-il un moyen d'automatiser cette taches (j'ai un fichier avec + de 5000 réfs) merci.

Ci-joint un fichier d'exemple.

 

[Hasco]

Bonjour,

dans le fichier joint vous trouverez cette macro commentée, lancée par un bouton sur la feuille 'Feuil1' :

Sub FaireleTruc()
With ThisWorkbook.Sheets("Feuil1").Range("A4").CurrentRegion
    ' copier coller la ligne d'entête
    .Rows(1).Copy .Offset(, .Columns.Count + 1)
    ' travailler sur les lignes et colonnes de données, sans les entêtes
    With .Offset(1).Resize(.Rows.Count - 1, 5)
        ' Copier coller l'ensemble
        .Copy .Offset(, .Columns.Count + 1)
        ' Copier La colonne REF et les colonnes 4,5 pour les coller en bas du tableau
        Union(.Columns(1), .Columns(4), .Columns(5)).Copy .Offset(.Rows.Count, .Columns.Count + 1)
        ' Nettoyer les données des deux dernières colonnes du nouveau tableaux
        .Offset(, .Columns.Count + 4).Resize(, 2).ClearContents
        With .Offset(, .Columns.Count + 1).Resize(, .Columns.Count).CurrentRegion
             ' Tri sur la colonne REF du nouveau tableau
             .Sort key1:=.Cells(1, 1), order1:=xlAscending, Header:=xlYes
         End With
    End With
End With
End Sub

ET dans la feuille 'Power Query' une proposition sans macro mais par Requête de données Power Query puisque vous êtes sous xl2019.

Cordialement

 

[sylvanu]

Bonjour Spooner, Roblochon,
Un essai en PJ avec :

Sub Tri()
Application.ScreenUpdating = False
DL = Range("A65500").End(xlUp).Row                      ' Taille tableau
NP = (Application.CountIf(Range("4:4"), "*") - 1) / 2   ' Nombre de paliers
Set sh = Sheets("Résultat")
Ind = 2                                                 ' Ind : index d'écriture
For L = 5 To DL                                         ' Pour toutes les lignes du tableau
    For C = 1 To NP                                     ' Pour tous les paliers
        sh.Cells(Ind, 1) = Cells(L, 1)                  ' Rangement REF
        sh.Cells(Ind, 2) = Cells(L, 2 * C)              ' Rangement Palier
        sh.Cells(Ind, 3) = Cells(L, 2 * C + 1)          ' Rangement Tarif
        Ind = Ind + 1                                   ' Ligne suivante
    Next C
Next L
sh.Select
End Sub

 

[SPOONER]

Bonjour Roblochon, Sylvanu,

Merci à tous les deux pour les propositions.
Dans les deux cas, cela fonctionne, juste un point :

Je peux avoir des articles qui ne possèdent pas de quantitatif, 'est à dire qu'ils ont uniquement un prix par 1.
Dans ce cas, des lignes vides sont créées. Peux t-on prendre en compte ce point ?

J'ai regardé le code, mais je ne vois pas comment faire.
Ce n'est pas urgent, vos solutions me débloquent déjà, je supprime les lignes vides manuellement.

 

[Hasco]

Re,

Avec un peu de recherche vous auriez trouvé sur le site maints exemple de suppression conditionnelle de lignes de tableau.

Dans le fichier joint la raquête power query prend désormais ce paramètre en compte et la macro a été modifiée telle que :

Sub FaireleTruc()
    Dim plg As Range
    Dim lig As Long
    With ThisWorkbook.Sheets("Feuil1").Range("A4").CurrentRegion
        ' copier coller la ligne d'entête
        .Rows(1).Copy .Offset(, .Columns.Count + 1)
        ' travailler sur les lignes et colonnes de données, sans les entêtes
        With .Offset(1).Resize(.Rows.Count - 1, 5)
            ' Copier coller l'ensemble
            .Copy .Offset(, .Columns.Count + 1)
            ' Copier La colonne REF et les colonnes 4,5 pour les coller en bas du tableau
            Union(.Columns(1), .Columns(4), .Columns(5)).Copy .Offset(.Rows.Count, .Columns.Count + 1)
            ' Nettoyer les données des deux dernières colonnes du nouveau tableaux
            .Offset(, .Columns.Count + 4).Resize(, 2).ClearContents
        End With
        Set plg = .Offset(, .Columns.Count + 1).Resize(, .Columns.Count).CurrentRegion
    End With
    '
    ' Travailler sur le nouveau tableau
    With plg
        ' Tri sur tarif 1 pour avoir les valeurs 0 en bas
        .Sort key1:=.Cells(1, 3), order1:=xlAscending, Header:=xlYes
        For lig = .Rows.Count To 2 Step -1
            ' Si Tarif 1 n'est pas vide alors sortir de la boucle
            If Not IsEmpty(.Cells(lig, 3)) Then Exit For
            .Rows(lig).Delete xlShiftUp
        Next lig

        ' Tri sur REF
        .Sort key1:=.Cells(1, 1), order1:=xlAscending, Header:=xlYes

    End With
End Sub

 

[SPOONER]

Merci Roblochon,

Super efficace. J'avais scruté les autres postes mais sans parvenir à mes fins.
Je regarde attentivement le fonctionne de votre fichier pour comprendre le process.

Bonne fin de journée,

Cordialement,

 

[Hasco]

Re,

Petites explications :

toutes les lignes entre le premier With ....End With travaillent par décalage du premier tableau
toutes les lignes entre le With plg.... End With travaillent directement sur le nouveau tableau.

Dans le code ci-dessous le nettoyage des colonnes Palier 2 et tarif 2 se fait à partir de la nouvelle plage.

Sub FaireleTruc()
    Dim plg As Range
    Dim lig As Long
    '
    ' Travail à partir du tableau d'origine
    With ThisWorkbook.Sheets("Feuil1").Range("A4").CurrentRegion
       
        ' copier coller la ligne d'entête
        .Rows(1).Copy .Offset(, .Columns.Count + 1)
       
        ' travailler sur les lignes et colonnes de données, sans les entêtes
        With .Offset(1).Resize(.Rows.Count - 1, 5)
            ' Copier coller l'ensemble
            .Copy .Offset(, .Columns.Count + 1)
            ' Copier La colonne REF et les colonnes 4,5 pour les coller en bas du tableau
            Union(.Columns(1), .Columns(4), .Columns(5)).Copy .Offset(.Rows.Count, .Columns.Count + 1)
        End With
       
        Set plg = .Offset(, .Columns.Count + 1).CurrentRegion
    End With
    '
    ' Travailler sur le nouveau tableau
    With plg
       
       ' Nettoyer les données des deux dernières colonnes du nouveau tableaux
        .Offset(1).Columns(4).Resize(.Rows.Count - 1, 2).ClearContents
    
       ' Tri sur tarif 1 pour avoir les valeurs 0 en bas
        .Sort key1:=.Cells(1, 3), order1:=xlAscending, Header:=xlYes
       '
       ' Suppression des lignes 0 pour la colonne tarif 1
          For lig = .Rows.Count To 2 Step -1
            ' Si Tarif 1 n'est pas vide alors sortir de la boucle
            If Not IsEmpty(.Cells(lig, 3)) Then Exit For
            .Rows(lig).Delete xlShiftUp
        Next lig

        ' Tri sur REF
        .Sort key1:=.Cells(1, 1), order1:=xlAscending, Header:=xlYes

    End With
End Sub

 

[SPOONER]

Re,

Merci pour l'explication, et les commentaires dans le code me sont très précieux.
Tu m'as énormément aidé.

A bientôt sur le forum peut être

 

[Staple1600]

Bonsoir

Dans le fichier joint la raquête power query prend désormais ce paramètre en compte et la macro a été modifiée telle que :

Je n'arrive pas à faire rentrer ma raquette dans Excel!
Pourtant puissante est ma quête...(Rhââ Lovely)
OK je sors

NB: je précise pour les esprits chagrins, Roblochon ne s'offusque pas de mes facéties