Microsoft 365 Transposer des quantitatifs sur une même colonne

SPOONER

XLDnaute Nouveau
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.
 

Pièces jointes

  • Transposer quantitatif.xlsx
    9.5 KB · Affichages: 20

Hasco

XLDnaute Barbatruc
Repose en paix
Bonjour,

dans le fichier joint vous trouverez cette macro commentée, lancée par un bouton sur la feuille 'Feuil1' :
VB:
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
 

Pièces jointes

  • Transposer quantitatif - PQ.xlsm
    33.8 KB · Affichages: 3
Dernière édition:

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Spooner, Roblochon,
Un essai en PJ avec :
VB:
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
 

Pièces jointes

  • Transposer quantitatif.xlsm
    21 KB · Affichages: 5

SPOONER

XLDnaute Nouveau
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

XLDnaute Barbatruc
Repose en paix
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 :
VB:
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
 

Pièces jointes

  • Transposer quantitatif - PQ.xlsm
    34.5 KB · Affichages: 4

Hasco

XLDnaute Barbatruc
Repose en paix
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.
VB:
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
 

Discussions similaires

Statistiques des forums

Discussions
311 711
Messages
2 081 794
Membres
101 817
dernier inscrit
carvajal