[VBA] Transposer colonnes en ligne par tronçons

Bonjour à tous,

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:

image

J'aimerai obtenir ceci:

image

Je parviens à faire le premier tronçon (avec V0), mais pas les suivants (V1,V2,V3)...

image

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.

12xor.xlsm (26.35 Ko)

En vous remerciant,

Cordialement,

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) <> 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+

Salut tout le monde !

Joli Algo+

Salut

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

Bonjour tout le monde,

AlgoPlus et AMIR,

Chapeau les artistes ! Vous êtes au top !

Je relève que la version d'AMIR, redimensionne automatiquement le tableau final, aussi, j'ai tenté de le faire également sur ton code AlgoPlus:

Fonctionne pour 4 visites (0 à 3) au delà il faudrait adapter le dimensionnement du tableau final (TF)

J'ai rajouté un dico pour la colonne B (pour compter le nombre de V différents * 5 (colonnes B à F) + 1 (colonne A)

For i = 1 To UBound(TI, 1)
   If Not mondico.Exists(TI(i, 2)) Then
           mondico(TI(i, 2)) = ""
        End If
 Next i

ReDim TF(1 To UBound(TI, 1), 1 To mondico.Count * 5 + 1) 'redimensionnement tablo final

Il semblerait que ce soit OK.....

J'ai également modifié ind pour que les V >9 soient pris en compte.

ind = Val(Mid$(TI(i, 2), 2))   'je supprime le premier caractère de gauche
7xor.xlsm (35.74 Ko)

@ AMIR : il faut que les "v" dans la colonne B soient triés dans l'ordre croissant, sinon ils ne sont pas dans le bon ordre dans la tableau final.

Mais ce n'est qu'un détail, bravo pour ton travail,


Un grand merci à vous 2 , je pense avoir compris les grandes lignes (de là à pouvoir le reproduire...),

Bonne continuation et à bientôt sur le forum,

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)

Salut xorsankukai, AlgoPlus

une autre version simplifiée a tester :

4xor-ver-03.xlsm (30.04 Ko)
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 < 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

Re,

AlgoPlus :

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)

Oui, effectivement, je l'avais constaté.....cela semble fonctionner jusqu'à V14 (mais laisse un vide) si la série est incomplète et plante au delà.

Mais bon, dans cet exercice, V0 étant la visite initiale et V1, Vx étant les visites suivantes, la série ne devrait jamais être incomplète,

Encore merci pour ton travail et tes commentaires constructifs.


AMIR:

une autre version simplifiée a tester :

Effectivement, tu obtiens bien le même résultat qu'AlgoPlus,

Mais même constat, la macro plante si la série de V n'est pas complète (ce qui dans cet exemple, ne devrait jamais être le cas).

Encore merci pour ton travail,


Vous avez répondu à mes attentes, à moi de bosser pour assimiler vos codes, mais la tâche va être rude...

Bonne soirée, à bientôt.

OK , Bonne soirée, à bientôt

Bonjour à tous,

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

Bonjour AlgoPlus,

une petite correction pour fonctionner même s'il manque une visite dans la liste .

Au top !

Merci ,

Amitiés.

Rechercher des sujets similaires à "vba transposer colonnes ligne troncons"