XL 2021 Récuper données dans une même case séparé par retour à la ligne

Guillaumeg3

XLDnaute Junior
Supporter XLD
Bonjour tout le monde,

J'aimérai récuper les données d'un champs adresse situé dans une meme case mais séparé par un retour à la ligne et les "découper" pour les afficher dans une case dédié.

Exemple:

A1
222 avenue des champs élysée
Paris
75001
France

Avoir en A2
222 avenue des champs élysé
Avoir en A3
Paris
Avoir en A4
75001
Avoir en A5
France

Il faut noter aussi que dans A1 si il n'y avait pas de retour à la ligne il n'y a pas de séparateur, on aurait alors 222 avenue des champs élyséeParis75001France

Merci de votre aide
 

fanfan38

XLDnaute Barbatruc
Bonjour
Un fichier est TOUJOURS le bienvenu.
Il faut le faire par macro en utilisant la fonction split
VB:
dim a
a=split(range("A1").value,chr(10))
range("A2").value=a(0)
range("A3").value=a(1)
range("A4").value=a(2)
range("A5").value=a(3)
A+ François
 

Cousinhub

XLDnaute Barbatruc
Bonjour,
Autre solution par le biais de Power Query (en natif dans ta version d'Excel)
Pour mettre à jour, clic droit dans la requête, "Actualiser" ou ruban "Données","Actualiser tout"
Bonne apm
 

Pièces jointes

  • PQ_Split.xlsx
    17.3 KB · Affichages: 4

job75

XLDnaute Barbatruc
Bonjour Guillaumeg3, fanfan38, Cousinhub,

Une solution par formules, voyez le fichier joint et les noms définis X et pos.

Formule en A2 à tirer sur A3:A5 :
Code:
=STXT(X;PETITE.VALEUR(pos;LIGNE()-1)+1;PETITE.VALEUR(pos;LIGNE())-1-PETITE.VALEUR(pos;LIGNE()-1))
A+
 

Pièces jointes

  • Eclater(1).xlsx
    10.3 KB · Affichages: 5

Guillaumeg3

XLDnaute Junior
Supporter XLD
Merci pour vos retours, je privilégie la fonction gauche ou droite et stxt dans mon cas.
Néanmoins en creusant j'ai déduit qu'il y aurait plusieurs paramètres à prendre en compte pour trier mes adresses.
J'ai joint un exemple. J'ai fait des tentatives mais je n'arrive pas avec le nombre de lignes
 

Pièces jointes

  • Classeur15.xlsx
    13.5 KB · Affichages: 2

job75

XLDnaute Barbatruc
Bonjour,

Vous n'avez pas essayé d'adapter ma solution du post #5 ???

Voyez ce fichier (2), la nouvelle définition du nom X et la formule en A4 :
Code:
=SIERREUR(STXT(X;PETITE.VALEUR(pos;LIGNE()-3)+1;PETITE.VALEUR(pos;LIGNE()-2)-1-PETITE.VALEUR(pos;LIGNE()-3));"")
à tirer vers le bas et vers la droite.

A+
 

Pièces jointes

  • Eclater(2).xlsx
    11.2 KB · Affichages: 1

Guillaumeg3

XLDnaute Junior
Supporter XLD
Merci Job

Oui mais j'ai toujours besoin que les lignes soient placés dans un ordre precis
Si le texte fait 6 lignes alors on range:
-la ligne 1 et 2 en concact séparé par une virgule en A4
-la ligne 3 en A5
-La ligne 4 en A6
-La ligne 5 en A7
-La ligne 6 en A8

Si le texte fait 5 lignes mais que l'avant dernière ligne n'est pas composé d'au moins 3 chiffres alors:
-la ligne 1 et 2 en concact séparé par une virgule en A4
-la ligne 3 en A5
-La ligne 4 en A6
-La ligne 5 en A8

Si le texte fait 5 lignes mais que l'avant dernière ligne est composé d'au moins 3 chiffres alors:
-la ligne 1 en A4
-La ligne 2 en A5
-la ligne 3 en A6
-La ligne 4 en A7
-La ligne 5 en A8

Si le texte fait 4 lignes alors:
-la ligne 1 en A4
-La ligne 2 en A5
-la ligne 3 en A7
-La ligne 4 en A8

Si le texte fait 3 lignes alors:
-la ligne 1 en A4
-La ligne 2 en A5
-la ligne 3 en A8

Si il y a un autre paramètre, et que A2 est non vide ,qui ne prends pas en compte les étapes précédente alors on affiche uniquement :
-La ligne 1 en A4

Si vide alors on met "TBA"

J'ai repris le code VBA split comme indiqué par fanfan38 mais je galère un peu
 

job75

XLDnaute Barbatruc
Bonjour le forum,

Voyez le fichier joint et la macro affectée au bouton :
VB:
Sub Eclater()
Dim c As Range, a$(), n%, s, i%, b$()
Application.ScreenUpdating = False
Rows("4:" & Rows.Count).ClearContents 'RAZ
For Each c In Range("A1", Cells(1, Columns.Count).End(xlToLeft))
    If CStr(c) <> "" Then
        Erase a: n = 0
        s = Split(c(2), vbLf)
        For i = 0 To UBound(s)
            If Trim(s(i)) <> "" Then
                ReDim Preserve a(n) 'base 0
                a(n) = s(i)
                n = n + 1
            End If
        Next i
        ReDim b(4) 'base 0
        Select Case n
            Case Is > 6: MsgBox "Trop de lignes en " & c(2).Address(0, 0) & " !"
            Case 6: b(0) = a(0) & ", " & a(1): b(1) = a(2): b(2) = a(3): b(3) = a(4): b(4) = a(5)
            Case 5
                If Val(a(3)) = Int(Val(a(3))) And Len(a(3)) > 2 Then
                    For i = 0 To 4: b(i) = a(i): Next i
                Else
                    b(0) = a(0) & ", " & a(1): b(1) = a(2): b(2) = a(3): b(4) = a(4)
                End If
            Case 4: b(0) = a(0): b(1) = a(1): b(3) = a(2): b(4) = a(3)
            Case 3: b(0) = a(0): b(1) = a(1): b(4) = a(2)
            Case 2: b(0) = a(0): b(4) = a(1)
            Case 1: b(0) = a(0)
            Case 0: b(0) = "TBA"
        End Select
        '---restitution---
        c(4).Resize(5) = Application.Transpose(b)
    End If
Next c
Columns.AutoFit 'ajustement largeurs
End Sub
Au post #11 on ne parle pas du cas "2 lignes", j'ai interprété.

A+
 

Pièces jointes

  • Eclater VBA(1).xlsm
    20.5 KB · Affichages: 2

Guillaumeg3

XLDnaute Junior
Supporter XLD
Merci beaucoup Fanfan38 et Job75.


J'avais réussi à faire quelque chose de correct avec cette formule mais les votres marchent très bien aussi !


VB:
Sub rangeText()

    Dim textArray() As String
    Dim i As Integer
    
    If Range("AS2").Value = "" Then
        Range("AS4").Value = "TBA"
        Exit Sub
    End If
    
    textArray() = Split(Range("AS2").Value, vbLf)
    
    
    Select Case UBound(textArray)
    
    
        Case 5
            Range("AS4").Value = textArray(0) & ", " & textArray(1)
            Range("AS5").Value = textArray(2)
            Range("AS6").Value = textArray(3)
            Range("AS7").Value = textArray(4)
            Range("AS8").Value = textArray(5)
      
            If Not IsNumeric(Left(textArray(3), 3)) Then
                Range("AS4").Value = textArray(0) & ", " & textArray(1)
                Range("AS5").Value = textArray(2)
                Range("AS6").Value = textArray(3)
                Range("AS8").Value = textArray(4)
            
            Else
                Range("AS4").Value = textArray(0)
                Range("AS5").Value = textArray(1)
                Range("AS6").Value = textArray(2)
                Range("AS7").Value = textArray(3)
                Range("AS8").Value = textArray(4)
            End If
        
      
        Case 3
            Range("AS4").Value = textArray(0)
            Range("AS5").Value = textArray(1)
            Range("AS7").Value = textArray(2)
            Range("AS8").Value = textArray(3)
        
      
        Case 2
            Range("AS4").Value = textArray(0)
            Range("AS5").Value = textArray(1)
            Range("AS8").Value = textArray(2)
    
    End Select
    
End Sub
 

Discussions similaires

Statistiques des forums

Discussions
312 215
Messages
2 086 329
Membres
103 182
dernier inscrit
moutassim.amine