Suppressions dans une chaine de caractères

Suppressions dans une chaine de caractères - VB/VBA/VBS - Programmation

Marsh Posté le 18-10-2013 à 07:34:58    

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
Reply

Marsh Posté le 18-10-2013 à 07:34:58   

Reply

Marsh Posté le 18-10-2013 à 11:44:02    

fabien888 a écrit :

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

 


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
Reply

Marsh Posté le 18-10-2013 à 15:41:17    

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
Reply

Marsh Posté le 18-10-2013 à 16:16:30    

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 :
  1. Private Function SupprimerDoublonChaine(sChaine As String) As String
  3. Dim sRes As String = String.Empty
  4. Dim tTmp() As String
  5. Dim cTmp As New Collection
  7. tTmp=sChaine.Split("/".ToCharArray())
  8. For Each s As String in tTmp
  9.   If Not cTmp.Contains(s) Then
  10.      cTmp.Add(s,s)
  11.      If sRes<>String.Empty Then sRes &= "/" & s Else sRes &= s
  12.   End If
  13. Next
  15. Return sRes
  17. 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  :o )


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

Marsh Posté le 18-10-2013 à 16:23:44    

En VBA par une autre méthode :
 

Code :
  1. Option Explicit
  3. Sub test()
  5. Dim chaine As String
  6. Dim tableau() As String
  7. Dim i As Integer
  8. Dim temp As String
  10. chaine = "Emanuel/Nathan/Victorien/Emanuel/Julien/Patrice/Patrice/Patrice"
  11. tableau = Split(chaine, "/" )
  12. ReDim Preserve tableau(UBound(tableau)) As String
  14. i = 0
  15. While UBound(tableau) >= i
  16.     temp = tableau(i)
  17.     tableau = Filter(tableau, temp, False)
  18.     ReDim Preserve tableau(UBound(tableau) + 1) As String
  19.     tableau(UBound(tableau)) = temp
  20.     i = i + 1
  21. Wend
  23. chaine = tableau(0)
  24. For i = 1 To UBound(tableau)
  25.     chaine = chaine & "/" & tableau(i)
  26. Next i
  28. 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
Reply

Marsh Posté le 18-10-2013 à 18:01:50    

 
           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 :
  1. Function TexteSansDoublon(Texte$, Séparateur$)
  2.          SP = Split(Texte, Séparateur)
  3.          ReDim AR(0)
  4.          AR(0) = SP(0)
  5.    
  6.          For P& = 1 To UBound(SP)
  7.              If IsError(Application.Match(SP(P), AR, 0)) Then
  8.                  N& = N& + 1
  9.                  ReDim Preserve AR(N)
  10.                  AR(N) = SP(P)
  11.              End If
  12.          Next
  14.          TexteSansDoublon = Join(AR, Séparateur)
  15. End Function
  18. Sub Demo()
  19.     MsgBox TexteSansDoublon("Emanuel/Nathan/Victorien/Emanuel/Julien/Patrice/Patrice", "/" )
  20. End Sub


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

Reply

Marsh Posté le 18-10-2013 à 19:59:29    

 
           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 :
  1. Function TexteSansDoublon$(Texte$, Séparateur$)
  2.     SP = Split(Texte, Séparateur$)
  3.     Do
  4.         TexteSansDoublon = TexteSansDoublon & IIf(TexteSansDoublon > "", Séparateur, "" ) & SP(0)
  5.                       SP = Filter(SP, SP(0), False)
  6.     Loop Until UBound(SP) = -1
  7. End Function
  10. Sub Demo()
  11.     MsgBox TexteSansDoublon("Emanuel/Nathan/Victorien/Emanuel/Julien/Patrice/Patrice", "/" )
  12. End Sub

           Seulement cinq lignes de code pour torcher la fonction sans doublon, je ne ferais pas plus court !
 
           Le bon week-end !
 

Reply

Marsh Posté le 19-10-2013 à 13:30:24    

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 :
  1. Option Explicit
  2.    
  3.     Sub test(chaine, separateur)
  4.         Dim tableau() As String
  5.         Dim i As Integer
  6.         Dim temp As String
  7.         Dim k As Integer
  8.         tableau = Split(chaine, separateur)
  9.         ReDim Preserve tableau(UBound(tableau)) As String
  10.         i = 0
  11.         While i < UBound(tableau)
  12.             temp = tableau(0)
  13.             tableau = Filter(tableau, temp, False)
  14.             ReDim Preserve tableau(UBound(tableau) + 1) As String
  15.             tableau(UBound(tableau)) = temp
  16.             i = i + 1
  17.         Wend
  18.         chaine = Join(tableau, separateur)
  19.         MsgBox chaine
  20.     End Sub
  21.    
  22.     Sub demo()
  23.         Dim chaine As String
  24.         Dim separateur As String
  25.         Call test("Emanuel/Emanuel/Nathan/Nathan/Victorien/Victorien/Emanuel/Julien/Julien/Patrice/Patrice/Patrice", "/" )
  26.     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
Reply

Marsh Posté le 20-10-2013 à 13:01:17    

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 …
 

Reply

Marsh Posté le 20-10-2013 à 14:06:54    

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

Code :
  1. Function TexteSansDoublon$(Texte$, Séparateur$)
  2.         SP = Split(Texte, Séparateur$)
  3.         Do
  4.             If TexteSansDoublon > "" Then
  5.                   TexteSansDoublon = TexteSansDoublon & Séparateur & SP(0)
  6.             Else
  7.                   TexteSansDoublon = TexteSansDoublon & SP(0)
  8.             End If
  9.             SP = Filter(SP, SP(0), False)
  10.         Loop Until UBound(SP) = -1
  11.     End Function
  12.     Sub Demo()
  13.         MsgBox TexteSansDoublon("Emanuel/Nathan/Victorien/Emanuel/Julien/Patrice/Patrice", "/" )
  14.     End Sub


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

Reply

Marsh Posté le 20-10-2013 à 14:06:54   

Reply

Marsh Posté le 20-10-2013 à 16:00:08    

 
           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 :
  1. Function TexteSansDoublon$(Texte$, Séparateur$)
  2.      SP = Split(Texte, Séparateur)
  3.      Do
  4.          TexteSansDoublon = TexteSansDoublon & S$ & SP(0)
  5.          SP = Filter(SP, SP(0), False):  S = Séparateur
  6.      Loop Until UBound(SP) = -1
  7. End Function


       … soit avec un simple  If  :

Code :
  1. Function TexteSansDoublon$(Texte$, Séparateur$)
  2.     SP = Split(Texte, Séparateur$)
  3.     Do
  4.         If TexteSansDoublon > "" Then TexteSansDoublon = TexteSansDoublon & Séparateur & SP(0) _
  5.                                  Else TexteSansDoublon = TexteSansDoublon & SP(0)
  6.         SP = Filter(SP, SP(0), False)
  7.     Loop Until UBound(SP) = -1
  8. 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 !
 

Reply

Marsh Posté le 21-10-2013 à 15:15:34    

 
           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 :
  1. Const LISTE$ = "Emanuel/Marie/Nathan/Victorien/Marie/Emanuel/Julien/Patrice/Jean-Marie/Patrice"
  2.    
  3.    
  4. Function SansDoublon$(Texte$, Séparateur$)
  5.          SP = Split(Texte, Séparateur)
  6.     Do
  7.          SansDoublon = SansDoublon & IIf(SansDoublon > "", Séparateur, "" ) & SP(0)
  8.                   SP = Filter(SP, SP(0), False)
  9.     Loop Until UBound(SP) = -1
  10. End Function
  11.    
  12.    
  13. Function TexteSansDoublon$(Texte$, Séparateur$)
  14.          SP = Split(Texte, Séparateur)
  15.          ReDim AR(0)
  16.          AR(0) = SP(0)
  17.    
  18.          For P& = 1 To UBound(SP)
  19.              If IsError(Application.Match(SP(P), AR, 0)) Then
  20.                  N& = N& + 1
  21.                  ReDim Preserve AR(N)
  22.                  AR(N) = SP(P)
  23.              End If
  24.          Next
  25.    
  26.          TexteSansDoublon = Join(AR, Séparateur)
  27. End Function
  28.    
  29.    
  30. Sub DemoSansDoublon()
  31.     MsgBox SansDoublon(LISTE, "/" )
  32. End Sub
  33.    
  34.    
  35. Sub DemoTexteSansDoublon()
  36.     MsgBox TexteSansDoublon(LISTE, "/" )
  37. 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 :
  1. Const LISTE$ = "Emanuel/Marie/Nathan/Victorien/Marie/Emanuel/Julien/Patrice/Jean-Marie/Patrice"
  2.    
  3.    
  4. Function SansDoublon$(Texte$, Séparateur$)
  5.          SP = Split(Séparateur & Replace(Texte, Séparateur, " " & Séparateur))
  6.     Do
  7.          S$ = S$ & SP(0):  SP = Filter(SP, SP(0), False)
  8.     Loop Until UBound(SP) = -1
  9.          SansDoublon = Mid$(S, 2)
  10. End Function
  11.    
  12.    
  13. Sub DemoSansDoublon()
  14.     MsgBox SansDoublon(LISTE, "/" )
  15. End Sub


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


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

Marsh Posté le 22-10-2013 à 12:25:06    

 
           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 :
  1. Const LISTE$ = "Emmanuel/Marie/Nathan/Jean/Victor/Marie/Emmanuel/Jean - Marie/Patrice/Patrice"
  2.  
  3.  
  4. Function SansDoublon$(Texte$, Séparateur$)
  5.          SP = Split("¤" & Replace(Texte, Séparateur, "¤" & Séparateur & "¤" ) & "¤", Séparateur)
  6.     Do
  7.          S$ = S$ & SP(0):  SP = Filter(SP, SP(0), False, 0)
  8.     Loop Until UBound(SP) = -1
  9.          SansDoublon = Replace$(Replace$(S, "¤¤", Séparateur), "¤", "" )
  10. End Function
  11.  
  12.  
  13. Sub DemoSansDoublon()
  14.     MsgBox SansDoublon(LISTE, "/" )
  15. 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 …
 

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed