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

[natorp]

Bonjour tout le monde

J'aimerais découper une ligne en plusieurs lignes en fonction du caractère ]
Dès que je trouve le caractère ] dans la ligne, je coupe jusqu'au prochain et je copie à la ligne suivante
J'ai un fichier très important à traiter, je vous joins un exemple

Merci pour votre aide, cordialement, Gérard

 

[sylvanu]

Bonjour Nathorp, Dudu,
Un exemple en PJ avec :

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

 

[natorp]

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

 

[alexga78]

Bonjour à tous,

Une approche Power Query.

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

 

[natorp]

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

 

[alexga78]

Bonjour @natorp,

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

Cordialement.

 

[sylvanu]

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

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

 

[natorp]

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

 

[job75]

Bonjour natorp, le forum;

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 ?

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

A+

 

[natorp]

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

 

[sylvanu]

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

ReDim Sortie(1 To 100000, 1 To 30)

Les "blancs" sont traités.

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

 

[natorp]

Yes !! merci beaucoup Sylvanu
C'est parfait

Bonne journée, cordialement, Gérard

 

[job75]

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

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.

 

[natorp]

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

 

[job75]

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