XL 2013 transposer colonne en ligne de facon conditionnelle

etrables

XLDnaute Nouveau
Bonjour,



Pourriez vous m'aider a creer une macro pour transposer les lignes en colonnes de facon conditionnel ?

En piece jointe un exemple de mon besoin.

Colonne A contient le pays - Colonne B contient les dates.

J'aurai besoin de transposer les lignes de date en colonne - en creant une nouvelle ligne a chaque changement de pays.

Le nom des pays peut etre different dans chaque fichier et devrait etre gere de facon dynamique en comparant peut etre la valeur du pays ligne X avec la valeur du pays ligne X+1 et si les valeurs sont differentes creer une nouvelle ligne de transposition.



En piece jointe

onglet Données_Initial - contient un exemple du contenu intial du fichier

onglet Resultat - contient un exemple du resultat souhaité



Merci beaucoup pour votre aide.
 

Pièces jointes

  • TEST_DATA.xlsx
    18.4 KB · Affichages: 20

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonjour @etrables,
Bienvenue sur XLD et bonne année :),

Cliquer sur le bouton Hop!

Le code est dans module1 :
VB:
Sub transposer()
Dim Source As Range, t, i&, n&, j&, ref As String
   Application.ScreenUpdating = False
   With Worksheets("Données_Initial")
      If .FilterMode Then .ShowAllData
      Set Source = .Range("a1:b" & .Cells(Rows.Count, "a").End(xlUp).Row)
      Source.Sort key1:=.Range("a1"), order1:=xlAscending, key2:=.Range("b1"), order2:=xlAscending, Header:=xlYes, MatchCase:=False
      t = Source.Resize(Source.Rows.Count + 1)
   End With
   With Worksheets("Resultat")
      .Rows("2:" & Rows.Count).Clear
     n = 1: ReDim r(1 To Columns.Count): r(1) = t(2, 1): r(2) = t(2, 2): j = 2
      For i = 3 To UBound(t)
         If t(i, 1) = r(1) Then
            j = j + 1: r(j) = t(i, 2)
         Else
            n = n + 1
            .Cells(n, "a").Resize(, j) = r
            r(1) = t(i, 1): r(2) = t(i, 2): j = 2
         End If
      Next i
      .Select
   End With
End Sub
 

Pièces jointes

  • etrables- TEST_DATA- v1.xlsm
    63.5 KB · Affichages: 13

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Etrables et bienvenu sur XLD,
En PJ un essai avec :
VB:
Sub Worksheet_Activate()
Dim MatIn, L%, C%, N%, Pays$
Application.ScreenUpdating = False
Cells.ClearContents
MatIn = Sheets("Données_Initial").Range("A2:B" & Sheets("Données_Initial").Range("A65500").End(xlUp).Row)
N = 1: Pays = "": L = 1: C = 1
While N < UBound(MatIn)+1
    If MatIn(N, 1) <> Pays Then
        Pays = MatIn(N, 1)
        L = L + 1: C = 1
        Cells(L, C) = MatIn(N, 1): C = C + 1: Cells(L, C) = CDate(MatIn(N, 2))
    Else
        C = C + 1: Cells(L, C) = CDate(MatIn(N, 2))
    End If
    N = N + 1
Wend
End Sub
La conversion se fait automatiquement en activant la feuille Résultats.
( J'ai un peu bidouillé la liste pour faire un test plus représentatif qu'avec deux pays. :) )

Addon : Bonjour MaPomme.
J'ai l'impression qu'avec la nouvelle version le refresh ne se fait pas systématiquement.

@etrables : Attention, à ce jeu vous ne pouvez avoir que 16384 lignes, car XL est limité à 16384 colonnes.
 

Pièces jointes

  • TEST_DATA.xlsm
    28.3 KB · Affichages: 14
Dernière édition:

Staple1600

XLDnaute Barbatruc
Bonjour le fil

=>mapomme
Ton code ne fonctionne pas sur ma version Excel.
Sans doute à cause de mon addon, car quand j'ouvre la PJ mon Excel
l'onglet de la feuille 1 affiche:
Données_Initiales
;)
Et j'ai le même bug avec le code de Sylvanu.
Je ne comprends pas d'où cela peut venir.

Quand je serai revenu, ailleurs, j'essaierai la solution de chris avec Power Query

En attendant, meilleurs voeux à tous.
;)
 

Staple1600

XLDnaute Barbatruc
Bonjour

Est-ce mapoire peut dire à mapomme d'aider ma pomme.
Parce que ma pomme est dans l'affliction céphalique et n'est pas mesure ou n'a pas d'oeufs...
...PUISSANCE Height
ne fonctionne pas dans Excel 2003.
Merci mapoire et mes salutations au futur membre maprune.
;)
 

Staple1600

XLDnaute Barbatruc
Re

=>macompote
J'avais compris, mapomme
Mais comme je le disais à mapoire, je suis souffreteux.
Et j'avions espéré que mapomme eut trouver le temps de faire une version antédiluvienne.
Je rassure mapoire et mapomme que dès la semaine prochaine, mon Excel aura pris 10 ans dans la tronche.
;)
EDITION: Je suis tellement dans le gaz que j'ai mal répondu à la question.
J'ai testé sur 2003, car dans la réalité qui est mienne jusqu'au retour chez Anne de B., je suis bloqué sur XP acoquiné avec XL2K3.
 

Discussions similaires

Statistiques des forums

Discussions
311 725
Messages
2 081 940
Membres
101 845
dernier inscrit
annesof