Discussion :

[neiluj26]

Bonsoir le forum,

J'ai un grand nombre de lignes où des noms de société sont écrits sur le modèle suivant: "S A R L DUPONT", et je cherche un moyen de supprimer les espaces entre les lettres uniques pour obtenir "SARL DUPONT", et j'avoue que je ne sais pas quelle fonction utiliser...

[mercatog]

Code :

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

Sheets("Feuil3").UsedRange.Replace "S A R L", "SARL"

[neiluj26]

Argh, j'aurais dû mieux m'expliquer et ne pas dire modèle, pardon. Malheureusement, il n'y a pas que le cas SARL. J'ai beaucoup de noms de société où les personnes qui ont saisi les noms au départ ont glissé des espaces (par exemple "A F P" ou "A B C D").

En fait, je cherche à supprimer les espaces simples entre les caractères uniques de ma chaîne. Je ne peux pas simplement supprimer tous les espaces car dans le cas de ma "S A R L DUPONT", si je supprime tous les espaces, je me retrouve avec "SARLDUPONT"...

[pgz]

Bonjour.

Tu peux essayer cette fonction

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Function fPurge(ByVal sBrut As String) As String
Dim i As Integer, b As Boolean
 
fPurge = Trim$(sBrut)
 
For i = Len(fPurge) To 2 Step -1
    If b Then
        If (Mid$(fPurge, i, 1) <> " ") And (Mid$(fPurge, i - 1, 1) = " ") Then fPurge = Mid$(fPurge, 1, i - 2) & Mid$(fPurge, i)
    Else
        b = (Mid$(fPurge, i, 1) = " ")
    End If
Next i
 
End Function

Testé avec

Code :

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

1
2
3
Sub test()
MsgBox fPurge("S A R L DUPONT")
End Sub

Et cela renvoie "SARL DUPONT".

Cordialement,

PGZ

[neiluj26]

Merci. Je tâche de comprendre la fonction, mais malheureusement, elle ne fonctionne pas avec des chaînes comme "A B C D". Le résultat donne "ABC D"...

Et je suis peut-être pas doué, mais quand je cherche "Trim$" dans l'aide, je ne trouve de résultat que pour Trim. Tu pourrais m'expliquer la différence?

[pgz]

Bonsoir.

De nombreuses fonctions de chaînes ont deux variantes, par exemple Left et Left$. La version sans "$" renvoie un variant, la versions avec "$" renvoie une chaîne de caratères et s'exécute plus rapidement.

Pour le code, tu soulèves le pb génériques de la difficulté de spécifier et d'établir un jeu de test.

Cette version corrige le point que tu précises, mais tu vas peut-être exprimer de nouveaux besoins...

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
Function fPurge(ByVal sBrut As String) As String
Dim i As Integer, b As Boolean
 
fPurge = " " & Trim$(sBrut) & " "
 
For i = Len(fPurge) To 2 Step -1
    If b Then
        If (Mid$(fPurge, i, 1) <> " ") And (Mid$(fPurge, i - 1, 1) = " ") Then
            fPurge = Mid$(fPurge, 1, i - 2) & Mid$(fPurge, i)
            i = i - 1
            b = True
        Else
            b = (Mid$(fPurge, i, 1) = " ")
        End If
    Else
        b = (Mid$(fPurge, i, 1) = " ")
    End If
Next i
 
fPurge = Trim$(fPurge)
 
End Function

Cordialement,

PGZ

[mercatog]

[EDIT 3]

Une autre proposition même s'il y a possibilité de plusieurs espaces successifs à l’intérieur (Code encore simplifié)

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Function Purge(ByVal Mot As String) As String
Dim NewMot As String
Dim i As Integer
Dim Tb
 
Tb = Split(Mot & " X")
For i = LBound(Tb) To UBound(Tb) - 1
    NewMot = NewMot & Tb(i) & IIf(Len(Tb(i)) <= 1 And Len(Tb(i + 1)) <= 1, "", " ")
Next i
Purge = Trim(Replace(NewMot, "  ", " "))
End Function

Purge(" A B CDE FG H I JKL M N O P ") donne AB CDE FG HI JKL MNOP

[mercatog]

Une autre proposition en utilisant les RegExp. (Nécessite l'activation de la référence VBScript Regular Expressions X.Y)

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
'Nécessite l'activation de la référence VBScript Regular Expressions X.Y
Function Reform(ByVal Mot As String) As String
Dim Reg As New VBScript_RegExp_55.RegExp
 
With Reg
    .Pattern = "(\s{1,})(\w{2,})"
    .Global = True
    Mot = .Replace(Mot, " |$2| ")
End With
Set Reg = Nothing
Mot = Replace(Mot, " ", "")
Mot = Trim(Replace(Mot, "|", " "))
Mot = Trim(Replace(Mot, "  ", " "))
Reform = Mot
End Function
 
Public Sub Test()
 
Debug.Print Reform(" M R BEAN 1 9 7 1")
End Sub

Point fort: Pas de boucle.

[neiluj26]

Bonjour,

Super, j'ai testé, et c'est exactement ce que je cherchais. Je vais maintenant chercher bien comprendre ces fonctions, parce que je ne suis pas très fort en VBA, mais encore moins en manipulation de chaînes.

Merci pour l'aide.