XL 2016 Comment bien extraire la 1ère et la dernière ligne d'une cellule contenant 3 ou 4 lignes

[Webperegrino]

Bonjour Le Forum,

J'échoue dans mes tentatives d'extraction de la première et la dernière ligne de texte à multiples retours de ligne dans une cellule (2, 3 ou 4) là où je voudrais appliquer cette formulation.

Dans l'étude-test ci-jointe, la cellule B2 est en Liste-Validation de B16 à B19 pour étudier les résultats en B6, B9 et B12.
En effet, j'ai essayé avec trois méthodes : fonction par VBA, matricielle ou formule.
Les résultats ne sont glorieux...

Pouvez-vous me corriger afin que les trois méthodes fonctionnent parfaitement ?
Merci,

Webperegrino

 

[sylvanu]

Bonjour Webperegrino,
Un exemple en PJ avec :

Function F_Extract(Chaine, Position)
    T = Split(Chaine, Chr(10))
    If Position = 1 Then F_Extract = T(0) Else F_Extract = T(UBound(T))
End Function

 

[mapomme]

Bonsoir à tous ,

Avec formule "simple" en B3 et formule "matricielle" en C3 : vour classeur joint sur la feuille "Feuil2".

 

[Webperegrino]

Le Forum,
Bonsoir Sylvanu,
Bonsoir Mapomme,
C'est parfait, vos deux propositions remplissent parfaitement mes désirs de correction des formules.

Si bien que, Mapomme, je peux intégre ceci dans ma cellule de destination

{=GAUCHE(B2;TROUVE(CAR(10);B2&CAR(10))-1)&CAR(10)&SIERREUR(STXT(B2;1+MAX(SIERREUR((STXT(B2;LIGNE(INDIRECT("1:" & NBCAR(B2)));1)=CAR(10))*LIGNE(INDIRECT("1:" & NBCAR(B2)));""));999);"")}

Merci beaucoup et bon week-end
Webperegrino

 

[Webperegrino]

Le Forum,
Sylvanu, Mapomme,
Je viens d'appliquer vos deux solutions dans mon application et elles remplissent parfaitement ... leur fonction.
Merci beaucoup,
Webperegrino

 

[Webperegrino]

Bonjour Le Forum,

Dans cette conversation datant de 2023, j’avais réussi à gérer, grâce à MaPomme et Sylvanu, la première ligne et la dernière ligne en extraction de cellules contenant du texte avec plusieurs retour à la ligne.
Ma application fonctionne ainsi à merveille.

Toutefois j’ai un nouvel objectif sur lequel je coince :
Selon que l’on a maintenant 3 lignes ou 4 lignes à gérer dans les cellules de la colonne B :
Existe-t-il une nouvelle fonction VBA …
… pour gérer les lignes centrales des cellules « Origine » de colonne B (lignes 2 et 3)
… avec le résultat placé dans le pavé D8:E12 de l’exemple ci-joint ?

En effet dans la colonne B, j'ai des saisies à 3 lignes et des saisies à 4 lignes.

J’ai réussi une approche par formules dans la deuxième feuille mais c'est du lourd à recopier sur 3 000 lignes dans mon vrai application !

Les fonctions du type de celle de Sylvanu sont intéressantes pour une copie sur un grand nombre de lignes.
Les formules issues de la proposition de Mapomme me sont utiles dans une autre application moins lourdes.

Merci à l’avance pour votre aide,
Webperegrino

 

[sylvanu]

Bonsoir Webperegrino,
Avec 3000 lignes ce sera plus rapide avec une macro qu'avec une fonction car il suffira de calculer qu'une seule fois. Les formules se recalculent à chaque modification de cellules.
Un essai en PJ avec :

Sub SplitChaine()
Application.ScreenUpdating = False
For L = 2 To [B10000].End(xlUp).Row ' Ligne de départ à adapter
    Chaine = Cells(L, "B")
    If Chaine <> "" Then
        If InStr(1, Chaine, Chr(10)) = 0 Then
            Cells(L, "C") = Chaine
        Else
            T = Split(Chaine, Chr(10))
            For C = 0 To UBound(T)
                Cells(L, 3 + C) = T(C)
            Next C
        End If
    Else
        Range(Cells(L, "C"), Cells(L, "F")).ClearContents
    End If
Next L
End Sub

On active la macro par appui sur le bouton. Elle traite les cellules vides et les chaines ayant 1,2,3,4 sous chaines ou éventuellement plus.

 

[mapomme]

Bonjour @Webperegrino , @sylvanu ,

Pour ce que j'en ai compris... Deux autres méthodes : par formules ou par fonction personnalisée pour extraire la Nième ligne.

Par formules (plage en vert)

Une formule en C13 pour extraire la première ligne. Cette formule est à recopier uniquement vers le bas. La formule est :
=SUPPRESPACE(GAUCHE(SUBSTITUE(SUPPRESPACE($B13);CAR(10);REPT(" ";200));200))

Une autre formule en D13 à pour extraire la 2ème ligne et les suivantes. Cette formule est à recopier vers la droite et vers le bas. La formule matricielle est :

=SUPPRESPACE(GAUCHE(STXT(SUBSTITUE(SUPPRESPACE($B13);CAR(10);REPT(" ";200));200*(COLONNES($B:B));9999);200))

Via une fonction personnalisée (plage en bleu)

Formule en C3 à recopier vers la droite et vers le bas : =ligneN($B3;COLONNES($C:C))

Le code de la fonction :

Function LigneN(ByVal Chaine As String, ByVal Position As Integer) As String
Dim t
   Position = Position - 1: t = Split(Chaine, Chr(10))
   If Position >= 0 And Position <= UBound(t) Then LigneN = t(Position)
End Function

 

[mapomme]

Re,

Pour extraire soit la 1ère soit la dernière ligne (mais aucune autre), d'autres formules et une autre fonction personnalisée :

Pour extraire la première ligne :
=SUPPRESPACE(GAUCHE(SUBSTITUE(SUPPRESPACE($B13);CAR(10);REPT(" ";200));200))

Pour extraire la dernière ligne :
=SUPPRESPACE(DROITE(SUBSTITUE(SUPPRESPACE($B13);CAR(10);REPT(" ";200));200))

Via une nouvelle formule personnalisée : =LignePremDer( Texte , Optional Dernier)

• Texte est le texte source
• Si Dernier est absent alors on retourne la première ligne
• Si Dernier est présent (il peut valoir n'importe quoi) alors on retourne la dernière ligne

 

[sylvanu]

Bonsoir Webperegrino, MaPomme,
En restant sur ma voie d'une macro, en PJ une version accélérée par utilisation d'arrays.
Sur mon I5, XL2007, les 3000 lignes sont traitées en 0.15s. ( au lieu de 2.5s avec la version précédente.)

Sub SplitChaine()
Dim Tablo, TabloS, T, L, C
Application.ScreenUpdating = False
Tablo = Range("B2:B" & [B10000].End(xlUp).Row)  ' A adapter suivant fichier réel
ReDim TabloS(1 To UBound(Tablo), 1 To 4)
For L = 1 To UBound(Tablo)
    Chaine = Tablo(L, 1)
    If Chaine <> "" Then
        If InStr(1, Chaine, Chr(10)) = 0 Then
            TabloS(L, 1) = Chaine
        Else
            T = Split(Chaine, Chr(10))
            If UBound(T) > 3 Then Nmax = 3 Else Nmax = UBound(T)
            For C = 0 To Nmax
                TabloS(L, C + 1) = T(C)
            Next C
        End If
    End If
Next L
[C2].Resize(UBound(TabloS, 1), UBound(TabloS, 2)) = TabloS 'C2 à adapter
End Sub

A noter que cette macro ne traite que 4 lignes max.

 

[Webperegrino]

Bonjour Le Forum,
Bonjour Sylvanu,
Bonjour Mapomme,
Vous me comblez !
Je viens de parcourir vos fichiers joints : toutes vos solutions sont magiques.
C'est parfait : vous répondez au-delà de mes interrogations et je vous en remercie tous les deux.
Je vais calmement étudier tous ces riches enseignements.
Merci à vous pour votre aide.
Cordialement,
Webperegrino