[VBA] Transposer colonnes en ligne par tronçons

Question

Toujours en galère avec ces variables " tablo ", j'aurai besoin de vos lumières, Ci-joint un tableau que je voudrai présenter autrement: J'aimerai obtenir ceci: Je parviens à faire le premier tronçon (avec V0), mais pas les suivants (V1,V2,V3)... Certains d'entre vous me conseilleront Power Query , mais je préfèrerai une solution via tablo, pour comprendre( du moins je l'espère ! ) le raisonnement et la manipulation des dimensions. Une solution a été apportée ici , mais bien trop complexe pour moi, si il y a plus simple, je suis preneur. En vous remerciant, Cordialement...

AlgoPlus · Accepted Answer

Bonjour xorsankukai , un essai : on prend les données dans un tableau et on copies ces données dans un autre tableau en fonction du N° de visite. Fonctionne pour 4 visites (0 à 3) au delà il faudrait adapter le dimensionnement du tableau final (TF) Sub Xors() Dim TI, TF, i As Long, Base As Worksheet, Prec As String, x As Integer Set Base = Sheets("Base ircb") TI = Base.Range("A1").CurrentRegion.Offset(1, 0) 'on met les données dans un tableau initial TI Prec = "Vide" ' ReDim TF(1 To UBound(TI, 1), 1 To 21) 'redimensionnement tablo final For i = LBound(TI, 1) To UBound(TI, 1) ind = Val(Right(TI(i, 2), 1)) 'recuperation du N° visite If TI(i, 1) &lt;&gt; Prec Then 'si l'ID de la ligne lue est différent de précédente ligne x = x + 1 'incrémentation ligne du tableau final Prec = TI(i, 1) TF(x, 1) = TI(i, 1) End If For j = 0 To 4 TF(x, ind * 5 + 2 + j) = TI(i, 2 + j) Next Next Base.Range("A20").Resize(x, UBound(TF, 2)) = TF 'adapter la cellule d'insertion du tableau End Sub A+...

21Formatic · Answer

Joli Algo+...

AMIR · Answer

Une autre proposition a tester : Sub test() Dim tbl, tmps, Bse As Worksheet Dim i%, x%, a%, n%, lgn%, g% Dim cntr%, drlgn% Set Bse = Sheets("Base ircb") drlgn = Bse.Cells(Rows.Count, "A").End(xlUp).Row tmps = Bse.Range("A2:F" & drlgn) For x = 2 To drlgn n = Application.CountIfs(Bse.Range("A2:A" & drlgn), tmps(x - 1, 1)) If cntr &lt; n Then cntr = n x = x + (n - 1) g = g + 1 Next ReDim tbl(g - 1, cntr * 5) For x = 2 To drlgn n = Application.CountIfs(Bse.Range("A2:F" & drlgn), tmps(x - 1, 1)) tbl(lgn, 0) = tmps(x - 1, 1) For i = 0 To n - 1 For a = 0 To 4 tbl(lgn, (a + 1) + (5 * i)) = tmps((x - 1) + i, a + 2) Next Next x = x + (n - 1) lgn = lgn + 1 Next Sheets("A").Range("A1").CurrentRegion.ClearContents Sheets("A").Range("A2").Resize(UBound(tbl, 1) + 1, UBound(tbl, 2) + 1) = tbl End Sub Crdlmts...

AlgoPlus · Answer

Le dico est effectivement le plus simple pour compter le nombre de Visites. Une version allégée :

For i = 1 To UBound(TI, 1)
    mondico(TI(i, 2)) = ""
Next i

Quelle que soit la version, s'il manque un N° de visite dans une "série" pour un ID (par ex : v0,v1,v3,v4..) , il y aura un décalage (et même un plantage avec ma version)

AMIR · Answer

Salut xorsankukai , AlgoPlus une autre version simplifiée a tester : Sub AMIR() 'AMIR Dim tbl, tmps, Bse As Worksheet Dim i%, x%, a%, n%, lgn%, g% Dim cntr%, drlgn% Set Bse = Sheets("Base ircb") drlgn = Bse.Cells(Rows.Count, "A").End(xlUp).Row tmps = Bse.Range("A2:F" & drlgn) For x = 2 To drlgn n = Application.CountIfs(Bse.Range("A2:A" & drlgn), tmps(x - 1, 1)) If cntr &lt; n Then cntr = n x = x + (n - 1) g = g + 1 Next 'ReDim tbl(g - 1, drlgn - 1) 'pour UBound(tbl, 2)= drlgn - 1(j'ai fais quelques essai )OU cntr * 5 ReDim tbl(g - 1, cntr * 5) ' mais pour nbre de ligne je dois passe par le "g" For i = 2 To drlgn x = Val(Mid(tmps(i - 1, 1), 2)) v = Val(Mid(tmps(i - 1, 2), 2)) tbl((x - 1), 0) = tmps((i - 1), 1) n = Application.CountIfs(Bse.Range("A2:A" & drlgn), tmps(i - 1, 1)) For a = 0 To 4 tbl((x - 1), a + (1 + (5 * (v)))) = tmps((i - 1), a + 2) Next Next Sheets("A").Range("A2").CurrentRegion.ClearContents Sheets("A").Range("A2").Resize(UBound(tbl, 1) + 1, UBound(tbl, 2) + 1) = tbl End Sub...

AMIR · Answer

OK , Bonne soirée, à bientôt...

AlgoPlus · Answer

Une petite correction pour fonctionner même s'il manque une visite dans la liste . .../.... TI = Base.Range("A1").CurrentRegion 'on met les données dans un tableau Initial TI For i = 2 To UBound(TI, 1) 'dico sur la colonne B (pour compter le nombre de v) mondico(TI(i, 2)) = Val(Mid$(TI(i, 2), 2)) Next i NbV = WorksheetFunction.Max(mondico.items) + 1 'Nombre de visites . +1 car on commence à 0 Prec = "Vide" ' ReDim TF(1 To UBound(TI, 1), 1 To NbV * 5 + 1) 'redimensionnement tablo final .../... J'ai modifié l'initialisation du Tableau Initial par rapport à la première version : TI = Base.Range("A1").CurrentRegion.Offset(1, 0) qui provoquait un décalage d'une ligne au début (c'était le but) mais aussi en fin .....