modification d'un mot via "replace"

Version imprimable

20/06/2011, 14h31
SofEvans

modification d'un mot via "replace"

Bonjour,

Je dois, sous excel 2010, remplacer des mots par leurs abreviations.
J'utilise cette forme :

Code:

str = Replace(str, "Direction Générale", "DG", 1, 1, vbTextCompare)

Le mot ou la phrase matché pouvant être n'importe où dans str.
Le problème vient du type de "régles d'abréviation" suivante :

Code:

str = Replace(str, "Fonction", "Fonc°", 1, 1, vbTextCompare)

lorsque str = "Fonctionnel".

Evidemment, ca me remplace "Fonctionnel" par "Fonc°nel" ...
Je dois donc matché un mot uniquement en totalité.

Problème, un mot n'est pas forcement suivi d'un espace dans mon cas.
Il peut y avoir ",", "&", "/" et plein d'autre caractere joyeux.

Je me demandais s'il n'y avais pas une fonction qui me permettrai de ne pas matché les chaine suivi d'une lettre.
J'ai pensé aux regex, mais j'ai du mal a mettre le système en place.

Avez-vous un conseil ou une piste à me proposer s'il vous plaît ?
Merci beaucoup de votre lecture.

Cordialement.
20/06/2011, 14h53
Didier Gonard

Citation:

Evidemment, ca me remplace "Fonctionnel" par "Fonc°nel" ...

Bonjour,

la différence flagrante entre les deux est la longueur de chaîne, donc en cumulant avec un LEN, ça devrait mieux marcher ;)

cordialement,

Didier

Bonjour,

Effectivement, cela aurai pu marcher si seul un mot était dans la chaine.
En réalité, j'en ai plus.

str peut ressembler a cela :

Citation:

mot1[separateur]mot2[separateur]Fonction[separateur]mot3[separateur]Fonctionnel

[separateur] peut contenir ",", "&", "/" et d'autre caractere que je ne peux lister mais il ne contient pas de lettres.

Donc, c'est pour cela que j'aurai aimé differencier "fonction" de "fonctionnel" en cherchant a savoir si après "fonction" il y a une lettre.

En fait, la règle d'abreviation "generique" est la suivante :

tout les mots terminant par "tion" se voient "tion" remplacer par "°".
Je liste manuellement les mot dans "replace".
Cependant, je ne me vois pas regarder pour tous les mot en "tion" s'il n'y a pas un mots qui continue, a l'instar de "Fonction" -> "Fonctionnel".

Voici ce que j'ai fait :

Code:

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
32
33
34
35
36
37
38
39
 
    'regle en "tion[s]" -> "°"
    str = Replace(str, "Opérations", "Opera°", 1, 1, vbTextCompare)
    str = Replace(str, "Opération", "Opera°", 1, 1, vbTextCompare)
    str = Replace(str, "Operations", "Opera°", 1, 1, vbTextCompare)
    str = Replace(str, "Operation", "Opera°", 1, 1, vbTextCompare)
    str = Replace(str, "informations", "Informa°", 1, 1, vbTextCompare)
    str = Replace(str, "information", "Informa°", 1, 1, vbTextCompare)
    str = Replace(str, "Evolutions", "Evolu°", 1, 1, vbTextCompare)
    str = Replace(str, "Evolution", "Evolu°", 1, 1, vbTextCompare)
    str = Replace(str, "Formation", "Forma°", 1, 1, vbTextCompare)
    str = Replace(str, "Facturation", "Factura°", 1, 1, vbTextCompare)
    str = Replace(str, "Géolocalisation", "Géolocalisa°", 1, 1, vbTextCompare)
    str = Replace(str, "Production", "Produc°", 1, 1, vbTextCompare)
    str = Replace(str, "Associations", "Associa°", 1, 1, vbTextCompare)
    str = Replace(str, "gestion", "Ges°", 1, 1, vbTextCompare)
    str = Replace(str, "Préparation", "Prépara°", 1, 1, vbTextCompare)
    str = Replace(str, "relations", "Relat°", 1, 1, vbTextCompare)
    str = Replace(str, "relation", "Relat°", 1, 1, vbTextCompare)
    str = Replace(str, "Rémunérations", "Rémunéra°", 1, 1, vbTextCompare)
    str = Replace(str, "Rémunération", "Rémunéra°", 1, 1, vbTextCompare)
    str = Replace(str, "Coordinations", "Coord°", 1, 1, vbTextCompare)
    str = Replace(str, "Coordination", "Coord°", 1, 1, vbTextCompare)
    str = Replace(str, "interventions", "interven°", 1, 1, vbTextCompare)
    str = Replace(str, "intervention", "interven°", 1, 1, vbTextCompare)
    str = Replace(str, "Fonctions", "Fonc°", 1, 1, vbTextCompare)
    str = Replace(str, "Fonction", "Fonc°", 1, 1, vbTextCompare)
    str = Replace(str, "Innovations", "Innov°", 1, 1, vbTextCompare)
    str = Replace(str, "Innovation", "Innov°", 1, 1, vbTextCompare)
    str = Replace(str, "Communications", "Com°", 1, 1, vbTextCompare)
    str = Replace(str, "Communication", "Com°", 1, 1, vbTextCompare)
    str = Replace(str, "Obligations", "Oblig°", 1, 1, vbTextCompare)
    str = Replace(str, "Obligation", "Oblig°", 1, 1, vbTextCompare)
    str = Replace(str, "fidélisation", "fidélisa°", 1, 1, vbTextCompare)
    str = Replace(str, "Administration", "Administra°", 1, 1, vbTextCompare)
    str = Replace(str, "Commercialisation", "Commercialisa°", 1, 1, vbTextCompare)
    str = Replace(str, "Satisfaction", "Satisfac°", 1, 1, vbTextCompare)
    str = Replace(str, "Distribution", "Distribu°", 1, 1, vbTextCompare)
    'fin regle en "tion[s]" -> "°"

Il y a une répétitions pour matché le "s" aussi, c'est pas joli-joli a voir mais ce n'est que comme ca que j'ai réussi a faire.

Merci beaucoup de ta participation.

Cordialement.

Citation:

Envoyé par SofEvans

Je me demandais s'il n'y avais pas une fonction qui me permettrai de ne pas matché les chaine suivi d'une lettre.

Bonjour SofEvans,

En suivant cette idée j'ai pensé à çà :
Code:

1 2 3 4 5 6 7 8 9 10 11 Dim Str$, n1%, n2% n1 = InStr(1, Str, "Fonction") If n1 > 0 Then If n1 = 1 Or Right(Left(Str, n1 - 1),1) = " " Then n2 = InStr(6, Str, " ") If n2 = 0 Then n2 = Len(Str) + 1 If n2 > 0 Then If n2 - n1 = Len("Fonction") Then Str = Replace(Str, "Fonction", "Fonc°", 1, 1, vbTextCompare) End If End If End If
Si le mot est trouvé alors :
Si le mot commence la chaine ou si le caractère précédent le mot est un espace alors :
Prendre la position de de l'espace d'après (ou le simuler quand on est en bout de chaine) et comparer la longueur du mot avec la longueur de la chaine

Cordialement

R

20/06/2011, 15h12
SofEvans
Bonjour,

Je vais étudier ton code, j'aimerai comprendre ce qu'il fait.
Je ne connait pas par exemple
Code:

1 2 Dim Str$, n1%, n2%
le $ et % me laisse perplexe, je vais me renseigner la dessus.

Merci beaucoup :ccool:
20/06/2011, 15h14
GuyXL

Oups il faut corriger cette ligne, sorry! :

Code:

If n1 = 1 Or Right(Left(Str, n1 - 1), 1) = " " Then

$ remplace as string
% remplace as integer

Edit : bonjour Ormonth (le rafraichissement avant de poster je maitrise pas...)
20/06/2011, 15h16
SofEvans

Bonjour,

je prend note de ta correction.
Merci beaucoup pour $ et %, j'avais commencé a chercher mais sans grand résultat pour le moment.

Comme je n'avais pas vu ton post de 15h01 avant de poster, la version fonction :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub test()
Dim Str$
    Str = RepBis(Str, "Fonction", "Fonc°")
End Sub
 
Function RepBis$(t$, x$, y$)
Dim n1%, n2%
RepBis = t
n1 = InStr(1, t, x)
If n1 > 0 Then
    If n1 = 1 Or Right(Left(t, n1 - 1), 1) = " " Then
        n2 = InStr(6, t, " ")
        If n2 = 0 Then n2 = Len(t) + 1
        If n2 > 0 Then
            If n2 - n1 = Len(x) Then RepBis = Replace(t, x, y, 1, 1, vbTextCompare)
        End If
    End If
End If
End Function

Cordialement

R

Bonjour
Une proposition simple en utilisant les RegExp (cd. tutoriel de cafeine)
Nécessite l'activation de la référence Microsoft Regular Expressions 5.5

Code:

1
2
3
4
5
6
7
8
9
10
11
12
'Active la référence Microsoft Regular Expressions 5.5
Function Remplace(ByVal Str As String) As String
Dim Rg As New VBScript_RegExp_55.RegExp
 
With Rg
    .Pattern = "tion(s$|s\s|$|\s)"
    .Global = True
    .IgnoreCase = True
    Remplace = Trim(.Replace(Str, "° "))
End With
Set Rg = Nothing
End Function

Exécute ce test et regarde le résultat

Code:

1
2
3
4
Sub test()
 
Debug.Print Remplace("ACTIVATION des opérations opérationnelles et organisation des organisations")
End Sub

Bonjour à tous,

Tout d'abord mes excuses pour ma précédente 'solution' qui ne prévoyait que le caractère espace comme séparateur.

Le problème semble s'être quelque peut transformé entre le post 1 et le post 3 ? Qu'est devenue la transformation Direction Générale en DG ?

Une proposition alternative à celle de Mercatog qui ne sera peut-être intéressante que dans l'exposé du post 1. Elle ne nécessite pas d'activer une référence.
Code:

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 Function RepBis(t$, x$, y$) Dim n1%, n2% n1 = 1 Do n2 = InStr(n1, t, x) t = RepTer(t, x, y, n1) n1 = InStr(n2 + 1, t, x) Loop Until n1 = 0 RepBis = t End Function Function RepTer$(t$, x$, y$, n%) Dim n1% RepTer = t n1 = InStr(n, t, x) If n1 > 0 Then If n1 = 1 Or AscValid(Right(Left(t, n1 - 1), 1)) = False Then If Len(t) = n1 + Len(x) - 1 Or AscValid(Right(Left(t, n1 + Len(x)), 1)) = False Then RepTer = Left(RepTer, n1 - 1) & Replace(t, x, y, n1, 1, vbTextCompare) End If End If End If End Function Function AscValid(x$) As Boolean If x = "" Then Exit Function Select Case Asc(x) Case 65 To 90, 97 To 122, 128 To 154, 160 To 165 AscValid = True End Select End Function
A appeler comme suit :

Code:

Str = RepBis(Str, "Fonction", "Fonc°")

Le problème des séparateurs biscornus est contourné en considérant comme valide seulement les caractères 65 To 90, 97 To 122, 128 To 154, 160 To 165 (voire une table ASCII pour modifier éventuellement).
Le problème des multiples occurrences du mot à trouver est contourné avec une fonction destinée à boucler sur une autre.
J'espère l'avoir suffisamment testée cette fois... :oops:
Cordialement

R