Transposition spécifique

[anber]

Bonjour le Forum,

Je bute sur une solution VBA pour transposer des données en fonction du nombre de valeurs séparées par des ;
dans d'autres colonnes.
Je ne sais pas si si assez claire comme explication
Ci-joint un fichier pour exemple

Merci

Bon WE

 

[Staple1600]

Bonjour le fil, le forum

Cette macro semble faire le job
(en tout cas elle le fait sur le fichier exemple)

Sub a()
Dim i&, x&, y&, t
For i = 2 To Cells(Rows.Count, "B").End(xlUp).Row
If InStr(Cells(i, "B"), ";") > 0 Then
t = Split(Cells(i, "B"), ";")
x = Cells(i, "B").Offset(1).Row
y = UBound(t)
Rows(x).Resize(y).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Cells(i, "B").Resize(y + 1) = Application.Transpose(t)
Cells(i, "A").Resize(y + 1).FillDown
Cells(i, "C").Resize(y + 1).FillDown
End If
Next
End Sub

 

[anber]

Bonjour Ce lien n'existe plus
Merci pour la réponse
Effectivement c'est le principe recherché
Par contre je souhaitais que le résultat soit réécrit à partir de la colonne I et non sur lui-même
Je pense que mon explication n'était pas assez claire, vous ne pouviez-vous pas deviner.
J'essais

Encore Merci

 

[Staple1600]

Re

Et quid des lignes insérées?
Donc la macro corrigée pour la colonne I

Sub b()
Dim i&, x&, y&, t
[A1].CurrentRegion.Copy [I1]
For i = 2 To Cells(Rows.Count, "B").End(xlUp).Row
If InStr(Cells(i, "j"), ";") > 0 Then
t = Split(Cells(i, "j"), ";")
x = Cells(i, "j").Offset(1).Row
y = UBound(t)
Rows(x).Resize(y).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Cells(i, "j").Resize(y + 1) = Application.Transpose(t)
Cells(i, "I").Resize(y + 1).FillDown
Cells(i, "K").Resize(y + 1).FillDown
End If
Next
End Sub

 

[anber]

Re,
Les lignes insérées ?
en recopie seulement
pour ce résulat
Encore Merci

 

[Staple1600]

Re

Tu as testé la macro b (du message#4)?
Si oui tu ne vois comme un léger problème?

 

[anber]

oui
les valeurs sont en double

 

[anber]

j'avais essayé une autre piste par le calcul du nombre d'occurence "; "+ 1 en parcourant la colonne B pour réécrire avec une boucle à la colonne I

 

[Staple1600]

Re

Non, je ne parle pas de cela

Mais des lignes insérées qui donc altère ton tableau original
Voir les cellules vides dans les colonnes A,B,C après exécution de la macro
(Voir ta copie d''écran de ton message précédent)

De quelles valeurs en double, tu parles??
La macro b telle que je l'ai écrite (et postée) sur le forum ne donne pas le résultat qu'on peut voir sur ta copie d'écran.
Voici ce que donne ma macro sur mon PC.

 

[anber]

non il n'y a pas de valeurs en double, je n'avais pas effacé tous les résultats
oui j'avais vu les lignes vides sur les données de base
c'est pour cela que je regardais aussi vers une autre solution de comptage d'occurence ;

 

[Staple1600]

Re

Suggestion
Il suffirait de copier sur une feuille temporaire
puis de recopier ensuite en colonne I...

Sub c()
Dim i&, x&, y&, t
[A1].CurrentRegion.Copy
On Error Resume Next
Sheets.Add
ActiveSheet.Paste
ActiveSheet.Name = "$$$"
For i = 2 To Cells(Rows.Count, "B").End(xlUp).Row
If InStr(Cells(i, "B"), ";") > 0 Then
t = Split(Cells(i, "B"), ";")
x = Cells(i, "B").Offset(1).Row
y = UBound(t)
Rows(x).Resize(y).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Cells(i, "B").Resize(y + 1) = Application.Transpose(t)
Cells(i, "A").Resize(y + 1).FillDown
Cells(i, "C").Resize(y + 1).FillDown
End If
Next
[A1].CurrentRegion.Copy Feuil1.[I1]
Application.DisplayAlerts = False
Sheets("$$$").Delete
End Sub

 

[anber]

oui
c'est possible d'utiliser un fonctionnement manuel en copie, le but est d'éclater les cellules ou il y a plusieurs valeurs (résultat d'une extraction)
même avec le code a c'est suffisant.

Mais c'était plus pour le fun .... je reste sur ma faim...
car en comptant le nombre de ; dans la cellule, en faisant + 1 et en réécrivant via une boucle, je n'ai pas trouvé, du moins pas encore

 

[zebanx]

Bonjour à tous,

@Staples1600
Merci pour ton code.

Je souhaite le sauvegarder et l'ai très légèrement modifiée pour permettre de refaire un tri ascendant dans la colonne A.
Cependant, en dupliquant les ";" dans la colonne B, j'ai eu un petit problème d'exécution avec l'incrémentation de la boucle "for" (ie : remise à jour pour aller jusqu'à la dernière ligne en "xlup").
Un code avec do...while me permet de contourner le problème mais je ne me souviens plus de la méthode pour remettre cette dernière ligne à jour avec une instruction "for... next" (que j'ai bien plus l'habitude d'utiliser).
Peux-tu stp m'aider pour cette modification ou est-il préférable de conserver une instruction de type "while" ?

Merci pour ton aide, ++
zebanx

 

[Staple1600]

Re, bonjour zebanx

oui
c'est possible d'utiliser un fonctionnement manuel en copie, le but est d'éclater les cellules ou il y a plusieurs valeurs (résultat d'une extraction)
même avec le code a c'est suffisant.

Où ai-je parlé de copie manuelle?

Tu n'aurais pas zappé la macro c par hasard?
(message#11)

@zebanx
Je regarderai ton fichier quand tu auras répondu à mon MP
(oui je sais c'est du chantage et c'est mal le chantage )

 

[anber]

Effectivement, j'ai zappé le code c
et ça fonctionne
Encore Merci