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

 

[zebanx]

Re, bonjour zebanx
@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 )

Trouvé (boucle FOR : "si vous n'êtes pas foutu d'aller de A à Z... pensez peut-être de partir de Z à A")

 

[Staple1600]

Re

@zebanx
Du coup, j'ai pas besoin de tenir ma promesse alors

 

[zebanx]

Un peu de bienveillance quand même

 

[klin89]

Bonsoir à tous,

Si tu tiens vraiment à compter les occurrences en colonne B :

Sub test()
    With Sheets("feuil1").Range("a1").CurrentRegion
        With .Offset(1).Resize(Rows.Count - 1)
            x = UBound(Split(Join(Application.Transpose(.Columns(2).SpecialCells(2)), ";"), ";")) + 1
            MsgBox x
        End With
    End With
End Sub

Génère une erreur en cas de cellules vides
klin89

 

[anber]

Bonjour klin89, le Forum,
Ce ne n'est tout à fait ce que je cherche, je ne veux pas le cumul de toute la colonne
mais compter cellule par cellule les ; et lorsqu'il en a, reporter d'autant de lignes que de ; +1
c'est le résultat qu'a obtenu @Staples1600 d'une autre manière
Merci d'avoir répondu

 

[anber]

Bonjour Staple1600, le Forum
Un cas que je n'avais pas vu :
s'il y a d'autres cellules avec ; dans la colonne B, ce ne pas pris en compte

 

[zebanx]

Bonjour Anber

Echanges sur la page précédente peut-être ?

++

 

[Si...]

Bon_soir

Avec ce que j'ai compris (et 1 Tableau Tbo ; 1 Array T ; un lancement particulier le tout adaptable facilement) ...

 

[anber]

Bonsoir zebanx, Si...
Merci pour vos réponses, il n'y a que l’embarras du choix
2 solutions intéressantes
++

 

[Staple1600]

Bonsoir le fil, le forum

Bonjour Staple1600, le Forum
Un cas que je n'avais pas vu :
s'il y a d'autres cellules avec ; dans la colonne B, ce ne pas pris en compte
Regarde la pièce jointe 1000469

Si j'étais moi, j'adopterai le code de Si...
Et comme je suis moi, je me corrigerai

NB: A tester sur la PJ de Si...
(testé sans lignes vides dans Tbo)

Sub d()
Dim i&, x&, y&, t
[Tbo].Copy
On Error Resume Next
Sheets.Add
ActiveSheet.Paste
ActiveSheet.Name = "$$$"
For i = Cells(Rows.Count, "B").End(xlUp).Row To 2 Step -1
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.[F2]
Application.DisplayAlerts = False
Sheets("$$$").Delete
End Sub

 

[anber]

Re,
J'avais enlevé [F2:H65000] = "" sur le code de Si...

Ce lien n'existe plus ta solution fonctionne aussi

Merci à tous

 

[Si...]

Re

Premier tour :

Après la suppression de lignes du tableau Tbo précédée de suppresion de la ligne de code [F2:H65000] = ""

Doit-on garder les lignes grisées superflues ? Dans le doute, j'ai prévu de les supprimer.

Pour les garder il suffirait de la déplacer la ligne

Private Sub Worksheet_SelectionChange(ByVal R As Range)
  If R.Address <> [E2].Address Then Exit Sub  'pour lancer
  [F2:H65000] = ""
  '...

Staple , c'est parce que T bo est beau que tu en fais une copie ?
Il me semble que tu prends un canon pour tuer un moustique. Libre à toi de le faire mais attention aux dégats. Tu risques de coucher à la belle étoile !

 

[job75]

Bonjour à tous,

Juste pour dire que chez moi le traitement par tableaux est 14 fois plus rapide que le traitement par cellules.

A+

 

[job75]

Re,

Avec un tableau rest de dimension évolutive c'est moins rapide, fichier (2).

A+