XL 2021 Découper une ligne en plusieurs lignes en fonction d'un caractère

sylvanu

XLDnaute Barbatruc

Supporter XLD

• 6 Novembre 2024

• #2

Bonjour Nathorp, Dudu,
Un exemple en PJ avec :

VB:

Sub Découpe()
Dim T, L%, C%
Application.ScreenUpdating = False
[A4:Z1000].ClearContents
T = [A1].CurrentRegion
L = 3: C = 1
For i = 1 To UBound(T, 2)
    If Left(T(1, i), 1) = "]" Then
        L = L + 1: C = 1
    Else
        C = C + 1
    End If
    Cells(L, C) = T(1, i)
Next i
End Sub

 

Pièces jointes

• Classeur1 (1).xlsm

  15 KB · Affichages: 1

Vote positif 0 Vote négatif

natorp

XLDnaute Barbatruc

• 6 Novembre 2024

• #3

Merci Sylvanu

Cette macro fonctionne mais ne traite pas toutes les colonnes, mon fichier s'arrête à la colonne FRZ
Qu'y a-t-il à changer ?

Cordialement, Gérard

 

Vote positif 0 Vote négatif

A

alexga78

XLDnaute Occasionnel

• 6 Novembre 2024

• #4

Bonjour à tous,

Une approche Power Query.

PowerQuery:

let
A = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
B = Table.Combine(List.TransformMany(Table.ToRows(A),
    each List.Transform({_}, each Table.Group(Table.FromList(_, each {_},{"x"}), "x", {"y",     
    each [x]},0, (x,y)=> Byte.From(y = "]TONREP"))[y]), (x,y)=> Table.FromRows(y)))
in
B

Cordialement

 

Vote positif 0 Vote négatif

natorp

XLDnaute Barbatruc

• 6 Novembre 2024

• #5

Merci alexga78
Mais je ne connais pas du tout Power Query
Je ne sais pas quoi faire avec ce que tu proposes
Désolé, Gérard

 

Vote positif 0 Vote négatif

A

alexga78

XLDnaute Occasionnel

• 6 Novembre 2024

• #6

Bonjour @natorp,

Avec le fichier: vos données en tableau structuré ("Table1") ou en plage nommée ("Table1") , puis "Données", "Actualiser tout".

Cordialement.

 

Pièces jointes

• Classeur1.xlsx

  19.2 KB · Affichages: 2

Vote positif 0 Vote négatif

sylvanu

XLDnaute Barbatruc

Supporter XLD

• 6 Novembre 2024

• #7

Re, bonjour le fil,
En passant par un array de sortie pour accélérer les choses :

VB:

Sub Découpe()
Dim T, L%, C%, Sortie
[A4:Z100000].ClearContents
ReDim Sortie(1 To 100000, 1 To 7)
T = [A1:FRZ1]
L = 1: C = 1
For i = 1 To UBound(T, 2)
    If T(1, i) = "" Then Exit For
    If Left(T(1, i), 1) = "]" Then
        L = L + 1: C = 1
    Else
        C = C + 1
    End If
    Sortie(L, C) = T(1, i)
Next i
[A4].Resize(UBound(Sortie, 1), UBound(Sortie, 2)) = Sortie
End Sub

 

Pièces jointes

• Classeur1 (V3).xlsm

  96.5 KB · Affichages: 0

Vote positif 0 Vote négatif

natorp

XLDnaute Barbatruc

• 6 Novembre 2024

• #8

Merci Sylvanu

J'ai une erreur sur la ligne "Sortie(L, C) = T(1, i)" : l'indice n'appartient pas à la sélection
Oups, ça vient de mon fichier original qui a plus de colonne entre 2 ]
Mais après correction, la macro ne traite pas toutes les colonnes
Je n'obtiens que 20 lignes alors qu'il devrait y en avoir beaucoup plus

Cordialement, Gérard

 

Vote positif 0 Vote négatif

job75

XLDnaute Barbatruc

• 6 Novembre 2024

• #9

Bonjour natorp, le forum;

natorp à dit:

Merci Sylvanu

Cette macro fonctionne mais ne traite pas toutes les colonnes, mon fichier s'arrête à la colonne FRZ
Qu'y a-t-il à changer ?

Cliquez pour agrandir...

C'est évident : pas de cellules vides entre les cellules pleines en ligne 1...

A+

 

Vote positif 0 Vote négatif

natorp

XLDnaute Barbatruc

• 6 Novembre 2024

• #10

Bien vu job75

J'ai effectivement des cellules vides dans la ligne A:FRZ
@sylvanu : est-il possible d'en tenir compte dans le code de la macro ?

Cordialement, Gérard

 

Vote positif 0 Vote négatif

sylvanu

XLDnaute Barbatruc

Supporter XLD

• 6 Novembre 2024

• #11

Re,
Une V4 à tester.
La largeur d'un champ est limité à 30 cellules, sinon changez :

VB:

ReDim Sortie(1 To 100000, 1 To 30)

Les "blancs" sont traités.

SVP, si problème fournissez un fichier vraiment représentatif.

 

Pièces jointes

• Classeur1 (V4).xlsm

  41.2 KB · Affichages: 4

Vote positif 0 Vote négatif

natorp

XLDnaute Barbatruc

• 6 Novembre 2024

• #12

Yes !! merci beaucoup Sylvanu
C'est parfait

Bonne journée, cordialement, Gérard

 

Vote positif 0 Vote négatif

job75

XLDnaute Barbatruc

• 6 Novembre 2024

• #13

Une solution très rapide qui utilise la commande Convertir :

VB:

Sub Eclate()
Dim a, s
a = ActiveSheet.UsedRange.Rows(1)
a = Application.Transpose(Application.Transpose(a))
s = Split(Join(a, vbTab), "]")
Rows("3:" & Rows.Count).ClearContents 'RAZ
With [A3].Resize(UBound(s) + 1)
    .Value = Application.Transpose(s)
    .TextToColumns .Cells(1), xlDelimited, Tab:=True 'commande Convertir
End With
End Sub

Il ne paraît pas utile d'ajouter "]" au début de A4 A5 A6.

 

Pièces jointes

• Classeur1.xlsm

  16.3 KB · Affichages: 7

Vote positif 0 Vote négatif

Solution

natorp

XLDnaute Barbatruc

• 6 Novembre 2024

• #14

Merci Job75
Je confirme : très rapide
Cordialement, Gérard

 

Vote positif 0 Vote négatif

job75

XLDnaute Barbatruc

• 6 Novembre 2024

• #15

J'ai copié la plage A1:U1 sur 16384 colonnes, la macro s'exécute en 1/10ème de seconde.

 

Vote positif 0 Vote négatif