Suppressions dans une chaine de caractères

Recherche :

Mot : Pseudo : Filtrer
Bas de page
Auteur	Sujet : Suppressions dans une chaine de caractères

fabien888

Bonjour,

j'ai un problème à résoudre sous VBA: j'ai des chaînes de caractères avec plusieurs prénoms séparés par des "/", exemple:
"Emanuel/Nathan/Victorien/Emanuel/Julien/Patrice/Patrice"
Je souhaiterai supprimer les prénoms en doubles, cela donnerai donc:
"Emanuel/Nathan/Victorien/Julien/Patrice"

Avez-vous une idée d'un code permettant cela? Sachant qu'il y a une centaines de prénoms différents.
Je recherche surtout un exemple de code qui fonctionne.

Merci infiniment par avance.

Fabien

Message cité 1 fois
Message édité par fabien888 le 18-10-2013 à 07:35:34

Publicité

Perfector

Memento mori

fabien888 a écrit :

Merci infiniment par avance.

Fabien

Pour chaque chaine :
1) Découpe la chaine dans un tableau grâce à Split()
2) Parcours le tableau et enregistre dans une collection les prénoms, avec le prénom en clé de collection (pour ne pas l'enregistrer 2 fois)
3) Une fois le parcours du tableau fini, parcoures la collection et tu construis la chaine finale

En moins de 10 lignes c'est fait

Message édité par Perfector le 18-10-2013 à 11:44:59

fabien888

Bonjour,

Merci beaucoup pour le process Agressive Perfector, mais quelqu'un peut-il me donner un bout de code correspondant?

Bon week-end à tout le monde, et encore merci d'avance.

Fabien

Message cité 1 fois

Perfector

Memento mori

fabien888 a écrit :

Bonjour,

Merci beaucoup pour le process Agressive Perfector, mais quelqu'un peut-il me donner un bout de code correspondant?

Bon week-end à tout le monde, et encore merci d'avance.

Fabien

Rapidos en Vb.net (ça doit être à peu près pareil en vba) :

Code :

Private Function SupprimerDoublonChaine(sChaine As String) As String
Dim sRes As String = String.Empty
Dim tTmp() As String
Dim cTmp As New Collection
tTmp=sChaine.Split("/".ToCharArray())
For Each s As String in tTmp
If Not cTmp.Contains(s) Then
cTmp.Add(s,s)
If sRes<>String.Empty Then sRes &= "/" & s Else sRes &= s
End If
Next
Return sRes
End Function

Bon week end (c'est bien parce que c'est vendredi car c'est rare que je donne du code tout cuit sur un forum )

Message édité par Perfector le 18-10-2013 à 16:17:28

MaybeEijOrNot

but someone at least

En VBA par une autre méthode :

Code :

Option Explicit
Sub test()
Dim chaine As String
Dim tableau() As String
Dim i As Integer
Dim temp As String
chaine = "Emanuel/Nathan/Victorien/Emanuel/Julien/Patrice/Patrice/Patrice"
tableau = Split(chaine, "/" )
ReDim Preserve tableau(UBound(tableau)) As String
i = 0
While UBound(tableau) >= i
temp = tableau(i)
tableau = Filter(tableau, temp, False)
ReDim Preserve tableau(UBound(tableau) + 1) As String
tableau(UBound(tableau)) = temp
i = i + 1
Wend
chaine = tableau(0)
For i = 1 To UBound(tableau)
chaine = chaine & "/" & tableau(i)
Next i
End Sub

C'est bien parce qu'il a déjà donné un code tout fait...

Message édité par MaybeEijOrNot le 18-10-2013 à 16:28:31

Marc L

Bonjour, bonjour,

en VBA j'hésite entre deux manières : via l'object Dictionary, un peu comme une collection
ou via la fonction EQUIV de la feuille de calcul.

Voici un exemple avec cette dernière (Match en VBA) :

Code :

Function TexteSansDoublon(Texte$, Séparateur$)
SP = Split(Texte, Séparateur)
ReDim AR(0)
AR(0) = SP(0)
For P& = 1 To UBound(SP)
If IsError(Application.Match(SP(P), AR, 0)) Then
N& = N& + 1
ReDim Preserve AR(N)
AR(N) = SP(P)
End If
Next
TexteSansDoublon = Join(AR, Séparateur)
End Function
Sub Demo()
MsgBox TexteSansDoublon("Emanuel/Nathan/Victorien/Emanuel/Julien/Patrice/Patrice", "/" )
End Sub

C'est dommage d'utiliser Split et ne pas penser à Join en retour …

Marc L

J'aimais bien l'idée de MaybeEijOrNot avec la fonction Filter mais je trouvais dommage que l'ordre d'origine du texte soit chamboulé …

Voici l'optimisation d'utilisation de cette fonction tout en conservant l'ordre :

Code :

Function TexteSansDoublon$(Texte$, Séparateur$)
SP = Split(Texte, Séparateur$)
Do
TexteSansDoublon = TexteSansDoublon & IIf(TexteSansDoublon > "", Séparateur, "" ) & SP(0)
SP = Filter(SP, SP(0), False)
Loop Until UBound(SP) = -1
End Function
Sub Demo()
MsgBox TexteSansDoublon("Emanuel/Nathan/Victorien/Emanuel/Julien/Patrice/Patrice", "/" )
End Sub

Seulement cinq lignes de code pour torcher la fonction sans doublon, je ne ferais pas plus court !

Le bon week-end !

MaybeEijOrNot

but someone at least

En même temps mon code était faux, j'avais remarqué que ça changeait d'ordre, du coup j'étais entrain de corriger puis je me suis dit que ce n'était pas important, du coup je suis resté entre 2 idées.

Correction :

Code :

Option Explicit
Sub test(chaine, separateur)
Dim tableau() As String
Dim i As Integer
Dim temp As String
Dim k As Integer
tableau = Split(chaine, separateur)
ReDim Preserve tableau(UBound(tableau)) As String
i = 0
While i < UBound(tableau)
temp = tableau(0)
tableau = Filter(tableau, temp, False)
ReDim Preserve tableau(UBound(tableau) + 1) As String
tableau(UBound(tableau)) = temp
i = i + 1
Wend
chaine = Join(tableau, separateur)
MsgBox chaine
End Sub
Sub demo()
Dim chaine As String
Dim separateur As String
Call test("Emanuel/Emanuel/Nathan/Nathan/Victorien/Victorien/Emanuel/Julien/Julien/Patrice/Patrice/Patrice", "/" )
End Sub

Et en effet autant utiliser la méthode Join si on y pense.

En fin de compte ton code est un peu plus court mais tu triches sur le IIf car autrement ça donne juste une ligne de moins car je ne peux pas passer par une boucle for car il ne réinterpréterai pas la condition de fin (taille du tableau qu'on fait varier à l'intérieur de la boucle) après chaque tour de boucle. :na:

Message cité 1 fois
Message édité par MaybeEijOrNot le 19-10-2013 à 17:39:12

Marc L

MaybeEijOrNot a écrit :

[…] mais tu triches sur le IIf car autrement ça donne juste une ligne de moins car je ne peux pas passer par une boucle for car il ne réinterpréterai pas la condition de fin (taille du tableau qu'on fait varier à l'intérieur de la boucle) après chaque tour de boucle.

Je ne te comprends pas du tout !

La fonction IIf sert juste à insérer le séparateur à partir du deuxième élément de la liste filtrée …

Une boucle For … Next n'est utile que lorsqu'on connaît un nombre déterminé d'éléments à traiter à l'avance
comme dans le cas de ma première proposition.

Dans ma deuxième, la plus efficace, toute la beauté réside dans le fait de ne pas savoir de combien d'éléments sera constituée
la liste finale et dans la réduction automatique du nombre d'éléments de la liste source au fur et à mesure du filtrage;
aucune triche, juste de la logique appliquée à la particularité d'une fonction …

MaybeEijOrNot

but someone at least

Non mais le IIf te permet d'économiser des lignes par rapport à If classic, c'est tout :

Code :

Function TexteSansDoublon$(Texte$, Séparateur$)
SP = Split(Texte, Séparateur$)
Do
If TexteSansDoublon > "" Then
TexteSansDoublon = TexteSansDoublon & Séparateur & SP(0)
Else
TexteSansDoublon = TexteSansDoublon & SP(0)
End If
SP = Filter(SP, SP(0), False)
Loop Until UBound(SP) = -1
End Function
Sub Demo()
MsgBox TexteSansDoublon("Emanuel/Nathan/Victorien/Emanuel/Julien/Patrice/Patrice", "/" )
End Sub

Tu es à 9 lignes normalement sans ce IIf, moi aussi je veux bien avoir un WWhile et passer à 4 lignes.

Publicité

Marc L

Bon, c'est une fonction qui a le mérite d'exister !

Et sans, je n'aurais besoin que d'une seule ligne supplémentaire, soit par l'utilisation d'une variable intermédiaire :

Code :

Function TexteSansDoublon$(Texte$, Séparateur$)
SP = Split(Texte, Séparateur)
Do
TexteSansDoublon = TexteSansDoublon & S$ & SP(0)
SP = Filter(SP, SP(0), False): S = Séparateur
Loop Until UBound(SP) = -1
End Function

… soit avec un simple If :

Code :

Function TexteSansDoublon$(Texte$, Séparateur$)
SP = Split(Texte, Séparateur$)
Do
If TexteSansDoublon > "" Then TexteSansDoublon = TexteSansDoublon & Séparateur & SP(0) _
Else TexteSansDoublon = TexteSansDoublon & SP(0)
SP = Filter(SP, SP(0), False)
Loop Until UBound(SP) = -1
End Function

Bref, quel que soit l'écriture à 5 ou 6 lignes de code,
l'auto-réduction de la liste source grâce à la fonction Filter s'avère simple & efficace !

Marc L

Parmi mes deux propositions, telles quelles, la première est la meilleure !
Car la fonction Filter est piégeuse, elle agit comme un filtre Contient !

Pour preuve :

Code :

Const LISTE$ = "Emanuel/Marie/Nathan/Victorien/Marie/Emanuel/Julien/Patrice/Jean-Marie/Patrice"
Function SansDoublon$(Texte$, Séparateur$)
SP = Split(Texte, Séparateur)
Do
SansDoublon = SansDoublon & IIf(SansDoublon > "", Séparateur, "" ) & SP(0)
SP = Filter(SP, SP(0), False)
Loop Until UBound(SP) = -1
End Function
Function TexteSansDoublon$(Texte$, Séparateur$)
SP = Split(Texte, Séparateur)
ReDim AR(0)
AR(0) = SP(0)
For P& = 1 To UBound(SP)
If IsError(Application.Match(SP(P), AR, 0)) Then
N& = N& + 1
ReDim Preserve AR(N)
AR(N) = SP(P)
End If
Next
TexteSansDoublon = Join(AR, Séparateur)
End Function
Sub DemoSansDoublon()
MsgBox SansDoublon(LISTE, "/" )
End Sub
Sub DemoTexteSansDoublon()
MsgBox TexteSansDoublon(LISTE, "/" )
End Sub

La fonction SansDoublon utilisant Filter élimine Jean-Marie !
En fait comme Marie le précède dans la liste, Jean-Marie contenant bien Marie …

L'astuce consiste alors à conserver le séparateur devant chaque élément de la liste source durant le filtrage :

Code :

Const LISTE$ = "Emanuel/Marie/Nathan/Victorien/Marie/Emanuel/Julien/Patrice/Jean-Marie/Patrice"
Function SansDoublon$(Texte$, Séparateur$)
SP = Split(Séparateur & Replace(Texte, Séparateur, " " & Séparateur))
Do
S$ = S$ & SP(0): SP = Filter(SP, SP(0), False)
Loop Until UBound(SP) = -1
SansDoublon = Mid$(S, 2)
End Function
Sub DemoSansDoublon()
MsgBox SansDoublon(LISTE, "/" )
End Sub

~~Cette fois c'est la bonne !~~ Et non, raté ‼ :pt1cable:

Message édité par Marc L le 22-10-2013 à 12:29:30

Marc L

En fait même problème avec Marie & Marie-Pierre ou encore Jean & Jean-Marie !

Il faut donc borner de chaque côté …

J'ai commencé à le faire avec l'espace mais alors "Jean - Marie" serait de nouveau éliminé si Jean ou Marie le précède !

Allez, la der de der !

Code :

Const LISTE$ = "Emmanuel/Marie/Nathan/Jean/Victor/Marie/Emmanuel/Jean - Marie/Patrice/Patrice"
Function SansDoublon$(Texte$, Séparateur$)
SP = Split("¤" & Replace(Texte, Séparateur, "¤" & Séparateur & "¤" ) & "¤", Séparateur)
Do
S$ = S$ & SP(0): SP = Filter(SP, SP(0), False, 0)
Loop Until UBound(SP) = -1
SansDoublon = Replace$(Replace$(S, "¤¤", Séparateur), "¤", "" )
End Function
Sub DemoSansDoublon()
MsgBox SansDoublon(LISTE, "/" )
End Sub

Moins simple mais toujours efficace !

Un bon p'tit cas d'école, je comprends mieux maintenant pourquoi je pense moins à utiliser Filter !

Comme quoi souvent la première idée …

FORUM HardWare.fr

Programmation

VB/VBA/VBS

Suppressions dans une chaine de caractères

Sujets relatifs
Multiplier les chiffres dans une chaîne de caractères	fgets ne lit pas les caractères spéciaux?
Fixer le nombre de caractères par ligne d'un fichier	inverser re.escape() pour des caractères non ASCII
extraire un entier d'une chaîne de caractère ; string	instancier une classe a patir d une chaine
VBA et chaine de caractères	[BATCH] choix des caractères
Plus de sujets relatifs à : Suppressions dans une chaine de caractères

Page générée en 0.099 secondes