Transposition spécifique

zebanx

XLDnaute Accro

• 12 Novembre 2017

• #16

Staple1600 à dit:

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

Cliquez pour agrandir...

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

 

Vote positif 0 Vote négatif

Staple1600

XLDnaute Barbatruc

• 12 Novembre 2017

• #17

Re

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

 

Vote positif 0 Vote négatif

zebanx

XLDnaute Accro

• 12 Novembre 2017

• #18

Un peu de bienveillance quand même 😛

 

Vote positif 0 Vote négatif

klin89

XLDnaute Accro

• 12 Novembre 2017

• #19

Bonsoir à tous, 🙂

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

VB:

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

 

Vote positif 0 Vote négatif

A

anber

XLDnaute Occasionnel

• 13 Novembre 2017

• #20

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

 

Vote positif 0 Vote négatif

A

anber

XLDnaute Occasionnel

• 13 Novembre 2017

• #21

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

 

Vote positif 0 Vote négatif

zebanx

XLDnaute Accro

• 13 Novembre 2017

• #22

Bonjour Anber

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

++

 

Pièces jointes

• transpose.xls

  49.5 KB · Affichages: 17

Vote positif 0 Vote négatif

S

Si...

XLDnaute Barbatruc

• 13 Novembre 2017

• #23

Bon_soir

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

 

Pièces jointes

• Eclate-Copie.xlsm

  23.3 KB · Affichages: 18

Vote positif 0 Vote négatif

A

anber

XLDnaute Occasionnel

• 13 Novembre 2017

• #24

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

 

Vote positif 0 Vote négatif

Staple1600

XLDnaute Barbatruc

• 13 Novembre 2017

• #25

Bonsoir le fil, le forum

anber à dit:

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

Cliquez pour agrandir...

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)

VB:

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

 

Vote positif 0 Vote négatif

A

anber

XLDnaute Occasionnel

• 13 Novembre 2017

• #26

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

Ce lien n'existe plus ta solution fonctionne aussi

Merci à tous

 

Vote positif 0 Vote négatif

S

Si...

XLDnaute Barbatruc

• 13 Novembre 2017

• #27

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

VB:

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

 

Vote positif 0 Vote négatif

job75

XLDnaute Barbatruc

• 14 Novembre 2017

• #28

Bonjour à tous,

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

A+

 

Pièces jointes

• Eclater(1).xlsm

  833 KB · Affichages: 11

Vote positif 0 Vote négatif

job75

XLDnaute Barbatruc

• 14 Novembre 2017

• #29

Re,

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

A+

 

Pièces jointes

• Eclater(2).xlsm

  832.8 KB · Affichages: 11

Vote positif 0 Vote négatif