Programme supprimer groupe caractère avant séparateur

Bonjour à tous,

J'ai dans une cellule des chaines de caractère avec un schéma homogène, juxtaposées avec un séparateur "|". J'aimerais aboutir à un programme permettant de modifier le contenu de mes groupes de chaines entre les séparateurs (InStr / Mid / Left / Right / Split / Trim), sans avoir à fragmenter, délimiter et recomposer les chaines mises bout à bout.

Plus précisément, je veux juste supprimer 3 blocs de caractères systématiquement avant chaque séparateur "|" (donc les 3 blocs à gauche du séparateur et, (objectif secondaire), remplacer en définitive le | par un ;.

Je trouve des tas de fonction comme celle-ci :

=SI(CHERCHE("|",C2)>0,GAUCHE(C2,CHERCHE("|",C2)-1))

Mais elles ne font que garder le 1er élément de la cellule avant le séparateur. Or, ce que je souhaiterais c'est appliquer cela pour chaque groupe entre séparateur et non seulement le 1er groupe.

Si jamais quelqu'un a le temps pour ce nouveau défi..

Merci,

En attendant je m'y recolle.

G.

Note : voici quelques programmes déjà aboutis pour tronçonner des chaines avec le repère spatial du séparateur, mais avec aucune je n'arrive à retoucher chaque groupe de la même façon.

Avec celle-ci jarrive à nettoyer uniquement 1 groupe à gauche du séparateur, mais mon nouveau fichier de départ n'a pas la même forme. C'est celle de Sebastien.

Sub nettoyage()
Dim Sh As Worksheet
For Each Sh In Worksheets
        For i = 2 To Sh.Range("B" & Rows.Count).End(xlUp).Row
        Sh.Cells(i, 2) = CleanText(Sh.Cells(i, 2))
        Sh.Cells(i, 2) = Left(Sh.Cells(i, 2).Value, Len(Sh.Cells(i, 2).Value) - 1)
        Next i
Next
End Sub

Public Function CleanText(sText As String) As String
Dim tbl As Variant, i As Long, x As String
    tbl = Split(Trim(sText), " ")
    For i = 0 To UBound(tbl) Step 2
        x = x & tbl(i) & ";"
    Next i
    CleanText = x
End Function

La même chose mais différemment

Sub test()
Dim Sh As Worksheet
For Each Sh In Worksheets

  For i = 2 To Range("B" & Rows.Count).End(xlUp).Row
   Cells(i, 2) = CleanText(Cells(i, 2))
  Next i
Next
End Sub
Public Function CleanText(sText As String) As String
Dim tbl As Variant, i As Long, x As String
    tbl = Split(Trim(sText), " ")
    For i = 0 To UBound(tbl) Step 2
        x = x & tbl(i) & ";"
    Next i
    CleanText = x
End Function

Fonction personnalisée de Jean-Eric ciblant un un nettoyage selon repère.

For i = 2 to x
cells(i,2)=CleanText(cells(i,2))
Next i

@ Sebastien

    Sub nettoyage()
        For l = 2 To 2 'A modifier pour parcourir les autres lignes
            t = Split(Range("B" & l), " ")
            For i = 0 To UBound(t)
                If UBound(Split(t(i), ";")) > 0 Then t(i) = ";"
            Next
            Range("C" & l) = Join(t, "")
        Next
    End Sub

Une autre solution que j'ai bien kiffé, mais qui est à ajuster,

Celle de R@chid si je me souviens bien :

Sub nettoyage()
        For l = 2 To Range("B" & Rows.Count).End(xlUp).Row 'A modifier pour parcourir les autres lignes
            t = Split(Range("B" & l), " ")
            For i = 0 To UBound(t)
                If UBound(Split(t(i), ";")) > 0 Then t(i) = ";"
            Next
            Range("C" & l) = Join(t, "")
        Next
End Sub

Elle fonctionne comme je l'entends, c'est à dire qu'elle ne se contente pas de traiter que le 1er groupe mais tous les groupes entre séparateurs. Par contre il reste à lui faire comprendre de supprimer les 3 blocs au lieu de 1 uniquement

G.

Public Function CleanText(sText As String) As String
Dim tbl1 As Variant, tbl2 As Variant, i As Long, x As String
    tbl1 = Split(Trim(sText), "|")
    x = ""
    For i = 0 To UBound(tbl1) - 1
        tbl2 = Split(Trim(tbl1(i)), " ")
        x = x & tbl2(UBound(tbl2)) & ";"
    Next i
    CleanText = Replace(Replace(x, "[", ""), "]", "")
End Function

erreur de ma part...

Cordialement.

je me suis contenté de conserver le dernier bloc, quelque soit le nombre de blocs avant le |

nota : je n'ai pas contrôlé par quoi se terminait la chaine d ecaractères, j'ai pris obligatoirement un | à la fin

Bonjour,

Une fonction personnalisée à tester.

Cdlt.

Option Explicit

Public Function CleanText(sText As String) As String
Dim tbl, tbl2
Dim I As Long
Dim x As String

    CleanText = ""
    tbl = Split(Trim(sText), "|")
    If UBound(tbl) > 0 Then
        For I = 0 To UBound(tbl) - 1
            tbl2 = Split(tbl(I), " ")
            x = x & tbl2(0) & ";"
        Next I
    End If

    CleanText = x

End Function

Jean-Eric,

je pense qu'il vaut mieux mettre :

x = x & tbl2(UBound(tbl2)) & ";"

Bonjour à tous !

Notez que la chaîne se termine par un séparateur, il y a donc toujours un dernier élément vide dans le 1er tableau...

Pour ma part j'aurais refait un Join avec ; sur le 1er tableau après épuration, plutôt que de l'introduire dans chaque élément... mais c'est en principe équivalent pour le résultat.

Cordialement.

Merci à tous, j'ai bien le résultat obtenu.

Par contre, comme relevé par MFerrand, avec les solutions de Steelson et Jean-Eric, il manque le dernier élément

Steelson

Public Function CleanText(sText As String) As String
    Dim tbl1 As Variant, tbl2 As Variant, i As Long, x As String
        tbl1 = Split(Trim(sText), "|")
        x = ""
        For i = 0 To UBound(tbl1) - 1
            tbl2 = Split(Trim(tbl1(i)), " ")
            x = x & tbl2(UBound(tbl2)) & ";"
        Next i
        CleanText = Replace(Replace(x, "[", ""), "]", "")
    End Function    

Je n'ai pas le dernier groupe, car la cellule d'origine ne se termine pas par le séparateur..

Jean-Eric

Public Function CleanText(sText As String) As String
    Dim tbl1 As Variant, tbl2 As Variant, i As Long, x As String
        tbl1 = Split(Trim(sText), "|")
        x = ""
        For i = 0 To UBound(tbl1) - 1
            tbl2 = Split(Trim(tbl1(i)), " ")
            x = x & tbl2(UBound(tbl2)) & ";"
        Next i
        CleanText = Replace(Replace(x, "[", ""), "]", "")
    End Function

Merci encore,

G.

Ton exemple ne le précisait pas, et d'ailleurs cela m'avait valu un bug.

Voilà qui est donc plus logique du reste !

Public Function CleanText(sText As String) As String
    Dim tbl1 As Variant, tbl2 As Variant, i As Long, x As String
        tbl1 = Split(Trim(sText), "|")
        x = ""
        For i = 0 To UBound(tbl1) 
            tbl2 = Split(Trim(tbl1(i)), " ")
            x = x & tbl2(UBound(tbl2)) & ";"
        Next i
        CleanText = Replace(Replace(x, "[", ""), "]", "")
    End Function        
 

On en a presque marre tellement ça marche.

Sub nettoie()
 Dim i As Long

    For i = 2 To Sheets(1).Range("C" & Rows.Count).End(xlUp).Row
    Sheets(1).Cells(i, 4).Value = CleanText(Sheets(1).Cells(i, 3))
    Next i

 End Sub

Public Function CleanText(sText As String) As String
    Dim tbl1 As Variant, tbl2 As Variant, i As Long, x As String
        tbl1 = Split(Trim(sText), "|")
        x = ""
        For i = 0 To UBound(tbl1)
            tbl2 = Split(Trim(tbl1(i)), " ")
            x = x & tbl2(UBound(tbl2)) & ";"
        Next i
        CleanText = Replace(Replace(x, "[", ""), "]", "")
    End Function

Un grand merci.

G.