Discussion :

[flouo]

Bonjour,

Dans une table j'ai de nombreuses lignes du style : "Regenerationrequired\r\nVehicleparked\r\nForyoursafety,readthemanual"

J'aimerais réaliser une macro qui sépare ce genre de ligne en autant de colonne que le sepérateur "\n\r" est trouvé (si possible j'aimerais aussi qu'il n'y ai pas de colonne vide entre les termes, mais ça c'est du bonus).

J'ai cherché pas mal de temps..mais je ne trouve pas de solution!

Une des seules pistes que j'ai est la suivante, mais malheureusement elle ne prend en compte qu'un séparateur (\) de un caractère et non 4.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
 
Sub format()
 
    ActiveWorkbook.Worksheets("lexEN").Activate
 
    Columns("B:B").Select
 
    Selection.TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
        TextQualifier:=xlNone, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="\n\r", FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
 
End Sub

[tedo01]

Bonjour,

Pour contourner le problème, une solution consisterait à d'abord remplacer les \r\n par un simple \, avant de faire le split :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
...
    Selection.Replace "\r\n", "\"        
    Selection.TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
        TextQualifier:=xlNone, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="\", FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
...

Une façon plus propre de faire : ne pas sélectionner un emplacement puis travailler sur l'objet Selection, mais travailler directement avec les Ranges cibles :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub format()
Dim objRange As Range
 
    Set objRange = ActiveWorkbook.Worksheets("lexEN").Columns("B:B")
 
    objRange.Replace "\r\n", "\"
 
    objRange.TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
        TextQualifier:=xlNone, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="\n\r", FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
 
End Sub

[Marc-L]

Bonjour, bonjour,

pas besoin de remplacer car le séparateur de la fonction Split peut contenir plusieurs caractères …

Sinon avec un fichier joint et un complément d'informations …

[casefayere]

Bonsoir le Forum, Marc, tedo01, flouo,
eh oui Marc, d'accord avec toi, un exemple

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Sub exemple_split()
Dim nom, x As Integer
nom = Split("Regenerationrequired\r\nVehicleparked\r\nForyoursafety,readthemanual", "\r\n")
For x = 0 To UBound(nom)
  MsgBox nom(x)
Next x
End Sub

[flouo]

Je vous remercie pour tous vos éléments de réponses, et je vous est trouvé très réactif, ça fait plaisir. Et vos solutions fonctionnent bien!

Au final j'ai trouvé une piste avant de voir vos réponses, je l'ai suivie. Même si ça peut paraître un peu tiré par les cheveux, ça répond à mon problème

Pour ceux que ça intéresserait :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
 
        Sheets("lexEN").Select
 
        Set rPlage = Worksheets("lexEN").UsedRange
 
        strChaine = "\r\n"
 
        For l = 1 To rPlage.Rows.Count
 
        Set rngTrouve = Worksheets("lexEN").Cells.Find(what:=strChaine)
 
            If rngTrouve Is Nothing Then
                Sheets("INTERFACE").Select
                Exit Sub
            Else
                Worksheets("lexEN").Cells.Find(what:=strChaine).Select
                lc = ActiveCell.Column
                lr = ActiveCell.Row
 
                Chaine = Cells(lr, lc).Value
 
                res_l = Left(Chaine, InStr(Chaine, strChaine) - 1)
                res_r = Right(Chaine, Len(Chaine) - InStr(Chaine, strChaine) - 3)
 
                Cells(lr, lc).Value = res_l
                Cells(lr, lc + 1).Value = res_r
 
            End If
            Set rngTrouve = Nothing
 
        Next l

Merci encore