XL 2016 Macro pour transposer un tableau selon un critère en colonne

manu49300

XLDnaute Nouveau
Bonjour à tous,

Je recherche un code VBA qui transformerait une mise en page de tableau selon un critère dans une colonne qui correspond à un code client. Le tableau d'origine peut avoir jusqu'à 2000 lignes.

Je vous joint le fichier type en exemple.

Merci d'avance.
Manu.
 

Pièces jointes

  • EXEMPLE.xlsx
    17.8 KB · Affichages: 8
Solution
Bonjour Manu,
Un essai en PJ.
A noter que le client 3 n'a que 3 produits, alors que dans votre feuille de restitution il en apparait 4. Il n'y a pas de XW96105. est ce une erreur ?
D'autre part je ne met pas les couleurs. Le tout avec :
VB:
Sub Redistribue()
    Dim tablo, T, NbClients%, RuptCde%, i%, Ligne%, Colonne%
    tablo = [A1].CurrentRegion
    NbClients = Application.Max([A:A])          ' Nombre de clients
    ReDim T(1 To NbClients, 1 To 100)           ' Max : 100 articles par client
    Sheets("DONNEES HORIZONTALES").[2:1000].ClearContents
    RuptCde = 1: Ligne = 1: Colonne = 3         ' Ligne et Colonne écriture
    For i = 2 To UBound(tablo)
        If tablo(i, 1) = RuptCde Then           ' Si code client correct...

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Manu,
Un essai en PJ.
A noter que le client 3 n'a que 3 produits, alors que dans votre feuille de restitution il en apparait 4. Il n'y a pas de XW96105. est ce une erreur ?
D'autre part je ne met pas les couleurs. Le tout avec :
VB:
Sub Redistribue()
    Dim tablo, T, NbClients%, RuptCde%, i%, Ligne%, Colonne%
    tablo = [A1].CurrentRegion
    NbClients = Application.Max([A:A])          ' Nombre de clients
    ReDim T(1 To NbClients, 1 To 100)           ' Max : 100 articles par client
    Sheets("DONNEES HORIZONTALES").[2:1000].ClearContents
    RuptCde = 1: Ligne = 1: Colonne = 3         ' Ligne et Colonne écriture
    For i = 2 To UBound(tablo)
        If tablo(i, 1) = RuptCde Then           ' Si code client correct
            If T(Ligne, 1) = "" Then            ' Si l'entete n'est pas inscrite
                T(Ligne, 1) = tablo(i, 1)       ' Rupt Cde
                T(Ligne, 2) = tablo(i, 2)       ' CLI
            End If
            T(Ligne, Colonne) = tablo(i, 6)     ' Article
            T(Ligne, Colonne + 1) = tablo(i, 4) ' Qté
            Colonne = Colonne + 2               ' Pour prochain article
        Else                                    ' Si nouveau code client
            RuptCde = RuptCde + 1               ' On incrémente la référence
            Ligne = Ligne + 1                   ' Nouvelle ligne dans tableau
            Colonne = 3                         ' Réinit colonne à 3
            i = i - 1                           ' On recule d'une ligne pour l'analyse suivante
        End If
    Next i
    ' Restitution du tableau
    Sheets("DONNEES HORIZONTALES").[A2].Resize(UBound(T, 1), UBound(T, 2)) = T
End Sub
 

Pièces jointes

  • EXEMPLE (7).xlsm
    26.5 KB · Affichages: 3

manu49300

XLDnaute Nouveau
Bonjour Manu,
Un essai en PJ.
A noter que le client 3 n'a que 3 produits, alors que dans votre feuille de restitution il en apparait 4. Il n'y a pas de XW96105. est ce une erreur ?
D'autre part je ne met pas les couleurs. Le tout avec :
VB:
Sub Redistribue()
    Dim tablo, T, NbClients%, RuptCde%, i%, Ligne%, Colonne%
    tablo = [A1].CurrentRegion
    NbClients = Application.Max([A:A])          ' Nombre de clients
    ReDim T(1 To NbClients, 1 To 100)           ' Max : 100 articles par client
    Sheets("DONNEES HORIZONTALES").[2:1000].ClearContents
    RuptCde = 1: Ligne = 1: Colonne = 3         ' Ligne et Colonne écriture
    For i = 2 To UBound(tablo)
        If tablo(i, 1) = RuptCde Then           ' Si code client correct
            If T(Ligne, 1) = "" Then            ' Si l'entete n'est pas inscrite
                T(Ligne, 1) = tablo(i, 1)       ' Rupt Cde
                T(Ligne, 2) = tablo(i, 2)       ' CLI
            End If
            T(Ligne, Colonne) = tablo(i, 6)     ' Article
            T(Ligne, Colonne + 1) = tablo(i, 4) ' Qté
            Colonne = Colonne + 2               ' Pour prochain article
        Else                                    ' Si nouveau code client
            RuptCde = RuptCde + 1               ' On incrémente la référence
            Ligne = Ligne + 1                   ' Nouvelle ligne dans tableau
            Colonne = 3                         ' Réinit colonne à 3
            i = i - 1                           ' On recule d'une ligne pour l'analyse suivante
        End If
    Next i
    ' Restitution du tableau
    Sheets("DONNEES HORIZONTALES").[A2].Resize(UBound(T, 1), UBound(T, 2)) = T
End Sub
Ok merci, ça fonctionne. Je vais adapter selon mes colonnes.
 

Discussions similaires

Réponses
2
Affichages
108

Statistiques des forums

Discussions
311 725
Messages
2 081 943
Membres
101 849
dernier inscrit
florentMIG