Logo GNT
Actualités Tests & Guides Bons Plans
GTA 6 iPhone 17 Copilot Switch 2 Temu ChatGPT Tesla
OVH Cloud OVH Cloud
Entraide Applications Microsoft Office Excel Info - Un autre petit exercice avec des expressions régulières

Info - Un autre petit exercice avec des expressions régulières

53 réponses
Avatar
Clément Marcotte
Bonjour,

Dans ma volonté d'expérimenter le plus possible les expressions
régulières, et devant la question qui revient quand même assez
souvent, j'ai bricolé la fonction suivante, laquelle va vous faire des
transformations selon les modèles suivants:

si vous avez un nom du genre "clément marcotte" dans une cellule, la
fonction va retourner "Clément Marcotte"

Si vous avec un nom du genre "jean-robert gauthier", la fonction va
retourner "Jean-Robert Gauthier"

Si vous avez un nom du genre "clément robert marcotte", la fonction va
retourner "Clément Robert Marcotte"

Si vous avez un nom du genre "clément robert de marcotte" la fonction
va retourner, ma paresse aidant, "Clément Robert De Marcotte"

Si vous avez un nom du genre "antoine de la rochefoucauld" (en
supposant que c'est bien Antoine), la fonction va retourner, toujours
ma paresse aidant, "Antoine De La Rochefoucauld"

Function PremiereLettreEnMajuscule(parametre As Variant) As Variant
Dim letexte As String, RE As Object, Matches As Object, match
letexte = CStr(parametre)
Set RE = New RegExp
'Recherche toutes les correspondances
RE.Global = True
'Ignore les différences majuscules/minuscules
RE.IgnoreCase = False
'Recherche le second prénom d'un prénom composé
RE.Pattern = "(-\w+)"
Set Matches = RE.Execute(letexte)
For Each match In Matches
'Met en majuscule l'initiale du second prénom
'd'un prénom composé
Mid(letexte, match.FirstIndex + 2, 1) = UCase(Mid(letexte,
match.FirstIndex + 2, 1))
Next
'Recherche les espaces et met en majuscules
'l'initiale du mot qui suit; même pour "de la"
'dans de la Rochefoucauld
RE.Pattern = "(\s\w+)"
Set Matches = RE.Execute(letexte)
For Each match In Matches
Mid(letexte, match.FirstIndex + 2, 1) = UCase(Mid(letexte,
match.FirstIndex + 2, 1))
Next
'met en majuscule, l'initiale du
'premier mot de la cellule
RE.Pattern = "(\w+)"
Set Matches = RE.Execute(letexte)
For Each match In Matches
Mid(letexte, 1, 1) = UCase(Mid(letexte, 1, 1))
Next
PremiereLettreEnMajuscule = letexte
End Function
Signaler un problème avec ce contenu

10 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
2 3 4 5 6
Avatar
Daniel.M
JPS,
===
je me réponds à moi-même avant d'aller dormir ; ben non, le And "des" ne
marche pas et cela fait une 1/2 heure que je triture le 2, le 3, le "des"
dans tous les sens sans parvenir à l'équivalent du "du" et du "de"....


Le 'And Left(s,3)<> "des" ' à l'INTÉRIEUR de la parenthèse devrait marcher,
comme GD l'a indiqué.

Ceci étant dit, comme vos demandes de changement n'ont semble-t-il pas de fin
;-), pourquoi ne pas mettre les mots clés dans une liste et faire un appel à la
fonction .Match()
Si on veut éviter l'appel à une fonction de l'Application Excel, on pourrait
faire une boucle pour savoir si le mot 's' est présent dans les SansMaj.

GD,
==
Je ne vois pas le problème avec O'Connors

Code:
==== Ça donne (et Thierry Garnier des Garets d'Ars devrait être content) :


'Met en majuscule la première lettre des mots de la cellule
'sauf quelques mots (SansMaj), un caprice de JPS et sa cour :-)
'
Function PremLettre(LeTexte As String) As String

Dim RE As Object, Matches As Object, UnMatch As Object
Dim s As String, decale As Integer
Dim SansMaj()

SansMaj = Array("du", "de", "d", "des", "van", "di", "del")

Set RE = CreateObject("VBScript.RegExp")
RE.Global = True 'Recherche toutes les correspondances
RE.IgnoreCase = True 'Ignore les différences maj/min

' Le pattern:
' De 0 à plusieurs caractères suivants: espace ou apostrophe ou tiret
' PUIS
' une suite de 1 à plusieurs lettres reconnues
RE.Pattern = "((s|'|-)*)" & _
"([A-ZßÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖØÙÚÛÜÝÞ]+)"

Set Matches = RE.Execute(LeTexte)

For Each UnMatch In Matches
With UnMatch
s = .SubMatches(2) ' le mot SANS les espaces/tirets/apostr situés avant
If Left(s, 2) = "mc" Then ' De mcdonald vers mcDonald
decale = .FirstIndex + 1 + Len(.SubMatches(1)) + 2
Mid(LeTexte, decale, 1) = UCase(Mid(LeTexte, decale, 1))
End If

'met 1 lettre en maj sauf pour quelques mots SansMaj
If IsError(Application.Match(s, SansMaj, 0)) Then
' le mot s n'est pas dans la liste SansMaj
' donc, on met sa première lettre en maj
decale = .FirstIndex + 1 + Len(.SubMatches(1))
Mid(LeTexte, decale, 1) = UCase(Mid(LeTexte, decale, 1))
End If
End With
Next UnMatch

PremLettre = LeTexte
End Function

Salutations,

Daniel M.

Avatar
Clément Marcotte
Bonjour,

Remplace la ligne suivante:

If (Left(s, 2) <> "de" And Left(s, 2) <> "du") Or Len(s) <> 2 Then

par

If (Left(s, 2) <> "de" And Left(s, 2) <> "du") Or (Len(s) <> 2 And
Len(s) <> 3) Then


Puis ajoute le bloc suivant juste avant end with

If (Left(s, 3) <> "des") Or Len(s) <> 3 Then ' met 1 lettre en maj
sauf si "des"
decale = .FirstIndex + 1 + Len(.SubMatches(1))
Mid(LeTexte, decale, 1) = UCase(Mid(LeTexte, decale, 1))
End If


"jps" a écrit dans le
message de news:
je me réponds à moi-même avant d'aller dormir ; ben non, le And
"des" ne

marche pas et cela fait une 1/2 heure que je triture le 2, le 3, le
"des"

dans tous les sens sans parvenir à l'équivalent du "du" et du
"de"....

au secours, daniel, clément, geedee
jps

"jps" a écrit dans le
message de

news:
bon, ben, boujour la foule
va être fou le daniel M quand je vais lui dire qu'il manque
encore un cas


:
j'ai un client qui s'appelle Thierry Garnier des Garets d'Ars
(oui, oui,


le
chatelain du bled de l'Ain où officiait le curé du même nom avant
d'être


béatifié)...
alors il va falloir ajouter encore un And.... "des", ok?
en tous cas, merci geedee pour cette explication que je ne
distingue pas


mais bon, il est tard...
jps

"GD" a écrit dans le message de
news:
Bonsour® Daniel, Clément ,
Joli travail qui va en satisfaire quelques uns ....

Bonsour® JPS......
simple question de logique (booléenne)
;o)))
If (Left(s, 2) <> "de" And Left(s, 2) <> "du") Or Len(s) <> 2
Then



godefoy gras comtesse du berry>>>>>Godefoy Gras Comtesse du
Berry




mais encore pour faire le pestou ... ;o)))
reste ce probleme qui est incompatible avec la règle des
O'Connors ;o)))




jean-paul sabotier d'azergue >>>> Jean-Paul Sabotier D'Azergue
ou bien
anémone gisquette d'estaing>>>>>Anémone Gisquette D'Estaing

;o)))



wrote:
oups petit bémol, daniel
tu as oublié de traiter le "du" de la comtesse du barry, par
ex.




j'ai essayé de modifier ta proc en ajoutant :

If Left(s, 2) <> "du" Or Len(s) <> 2 Then ' met 1 lettre en
maj sauf




si "de" Mid(LeTexte, Match.FirstIndex + 1 +
Len(Match.SubMatches(0)), 1) = _
UCase(Mid(LeTexte,




Match.FirstIndex + 1 + _
Len(Match.SubMatches(0)), 1))





End If

eh ben merdum de merdum, ça ne prend pas en charge le "pas de
majuscule" à "du"...
comment faut-il faire alors pour avoir et "de" et "du"???? moi
pas y




arriver...
jps

"jps" a écrit dans
le




message de news:ukMJ$
chapeau, daniel
et je suis content d'avoir fait mon caprice, même si je ne
suis pas





allé jusqu'à faire pipi dans le VBE et me rouler dans le
module...





jps

"Daniel.M" a écrit dans le
message





de news:
Salut,

La fonction étant relativement courte, je la copie ici.
Ça donnerait quelque chose comme ce qui suit. Les
instructions à






l'intérieur de la boucle auraient pu se limiter à une seule
copie






mais je voulais traiter McDonald (qui introduisait
l'utilisation






des SubMatches). De plus, j'ai intégré (mais pas beaucoup
testé)






une modif pour empêcher "de" d'être changé en "De".

'Met en majuscule la première lettre des mots de la cellule
'sauf le "de" : un caprice de JPS
'
Function PremLettre(LeTexte As String) As String

Dim RE As Object, Matches As Object, Match As Object
Dim s As String

Set RE = New RegExp
RE.Global = True 'Recherche toutes les correspondances
RE.IgnoreCase = True 'Ignore les différences maj/min

' Le pattern:
' un espace, un apostrophe, un tiret ou rien
' PUIS
' une suite de lettres reconnues
RE.Pattern = "(s|'|-|)" & _
"([A-ZßÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖØÙÚÛÜÝÞ]+)"

Set Matches = RE.Execute(LeTexte) ' le seul appel

For Each Match In Matches
s = Match.SubMatches(1)
If Left(s, 2) = "mc" Then ' De mcdonald vers mcDonald
Mid(LeTexte, Match.FirstIndex + 1 +
Len(Match.SubMatches(0)) + 2, 1) = _
UCase(Mid(LeTexte, Match.FirstIndex + 1 + _
Len(Match.SubMatches(0)) + 2, 1)) End If
If Left(s, 2) <> "de" Or Len(s) <> 2 Then ' met 1 lettre
en maj






sauf si "de" Mid(LeTexte, Match.FirstIndex + 1 +
Len(Match.SubMatches(0)), 1) = _
UCase(Mid(LeTexte,






Match.FirstIndex + 1 + _
Len(Match.SubMatches(0)),






1)) End If
Next Match

PremLettre = LeTexte
End Function


Je ne dis pas non. J'aimerais justement pouvoir passer à
"la







première école", mais je me retrouve toujours en chicane
avec les







Patterns, et je perds patience. Je me dis alors que vaut
mieux un







programme "qui marche" que rien du tout.


















Avatar
Clément Marcotte
Bonjour,

Comme j'ai vu que "d'ars" devenait "D'Ars" et que j'ai crains que tu
demandes une nouvelle modification pour "d'", j'ai don pris les
devants. Voici don où je suis rendu. (Et au diable les van, les di et
les del.)

Function PremLettre(LeTexte As String) As String
' met 1 lettre en maj sauf si "de","du","des", "d".
' changement au devis : JPS de + en + cap.......
'Daniel Maher mpfe
'modifiée par Clément Marcotte pour "des" et "d"
Dim RE As Object, Matches As Object, UnMatch As Object
Dim s As String, decale As Integer

Set RE = CreateObject("VBScript.RegExp")
RE.Global = True 'Recherche toutes les correspondances
RE.IgnoreCase = True 'Ignore les différences maj/min

' Le pattern:
' De 0 à plusieurs caractères suivants: espace ou apostrophe ou tiret
' PUIS
' une suite de 1 à plusieurs lettres reconnues
RE.Pattern = "((s|'|-)*)" & _
"([A-ZßÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖØÙÚÛÜÝÞ]+)"

Set Matches = RE.Execute(LeTexte)

For Each UnMatch In Matches
With UnMatch
s = .SubMatches(2)
If Left(s, 2) = "mc" Then ' De mcdonald vers mcDonald
decale = .FirstIndex + 1 + Len(.SubMatches(1)) + 2
Mid(LeTexte, decale, 1) = UCase(Mid(LeTexte, decale, 1))
End If
If (Left(s, 2) <> "de" And Left(s, 2) <> "du" And Left(s, 1) <> "d")
Or (Len(s) > 3) Then ' met 1 lettre en maj sauf si "de" ou "du"
decale = .FirstIndex + 1 + Len(.SubMatches(1))
Mid(LeTexte, decale, 1) = UCase(Mid(LeTexte, decale, 1))
End If
If Left(s, 3) <> "des" And Left(s, 1) <> "d" Then ' met 1 lettre en
maj sauf si "des"
decale = .FirstIndex + 1 + Len(.SubMatches(1))
Mid(LeTexte, decale, 1) = UCase(Mid(LeTexte, decale, 1))
End If
End With
Next UnMatch
PremLettre = LeTexte
End Function

P.S. Oublie mon autre réponse à ton "au secours"
Avatar
Clément Marcotte
Bonjour,

GD,
== >
Je ne vois pas le problème avec O'Connors



Moi non plus, ni avec O'Shaugnessy

P.S. Pour van, di et del; c'était plutôt une farce.

Avatar
Clément Marcotte
Bonjour,

Au moment où tu te lèves, je suis sur le point d'aller me coucher à
mon tour. Finalement, tu as le choix entre deux approches.

1) La procédure finale de Daniel est plus "compacte" et peut-être plus
efficace, mais, l'utilisation de la formule de feuille de calcul
"match" la rend difficilement utilisable en dehors d'Excel.

2) D'autre part, la procédure initiale de Daniel que j'ai modifiée est
plus longue et peut-être un peu moins performante. Mais elle reste
plus facilement exportable à l'extérieur d'Excel.

Donc conclusion, le choix final dépend un peu des besoins de
l'utilisateur. Mais si tu restes dans Excel, la procédure finale de
Daniel est joliment astucieuse.
Avatar
Daniel.M
JPS,
=== >
je me réponds à moi-même avant d'aller dormir ; ben non, le And "des" ne
marche pas et cela fait une 1/2 heure que je triture le 2, le 3, le "des"
dans tous les sens sans parvenir à l'équivalent du "du" et du "de"....


Le 'And Left(s,3)<> "des" ' à l'INTÉRIEUR de la parenthèse devrait marcher,


Pas vrai car les chaînes n'ont pas la même longueur.
Voir la réponse de Clément là-dessus (un peu plus loin de le fil).

Salutations,

Daniel M.


Avatar
jps
:-)))))
sacré daniel
puisque, sur un caprice de clément, tu as rendu cette Function
internationale (encore qu'il faille se méfier des Di, Del, Dos, Da, Dall',
Della -et je dois en oublier- qui, je crois ne pas me tromper, s'écrivent
avec une majuscule) internationale disais-je, je me charge de la vendre dans
le monde entier ; rassure-toi, je me contenterai, en guise de rémunération,
de conserver le fruit des dix premières ventes (ce chiffre n'est pas un
hasard : c'est le barême applicable pour ce genre d'action commerciale,
n'est-ce pas FS?)...
en tous cas, merci daniel pour ce dernier effort car il est maintenant
facile à chacun de modifier les particules à son gré (je pense à Rai qui ne
manquera d'ajouter "von" à la liste des SansMaj...
jps

"Daniel.M" a écrit dans le message de
news:%
JPS,
=== >
je me réponds à moi-même avant d'aller dormir ; ben non, le And "des" ne
marche pas et cela fait une 1/2 heure que je triture le 2, le 3, le
"des"


dans tous les sens sans parvenir à l'équivalent du "du" et du "de"....


Le 'And Left(s,3)<> "des" ' à l'INTÉRIEUR de la parenthèse devrait
marcher,

comme GD l'a indiqué.

Ceci étant dit, comme vos demandes de changement n'ont semble-t-il pas de
fin

;-), pourquoi ne pas mettre les mots clés dans une liste et faire un appel
à la

fonction .Match()
Si on veut éviter l'appel à une fonction de l'Application Excel, on
pourrait

faire une boucle pour savoir si le mot 's' est présent dans les SansMaj.

GD,
== >
Je ne vois pas le problème avec O'Connors

Code:
==== > Ça donne (et Thierry Garnier des Garets d'Ars devrait être content) :


'Met en majuscule la première lettre des mots de la cellule
'sauf quelques mots (SansMaj), un caprice de JPS et sa cour :-)
'
Function PremLettre(LeTexte As String) As String

Dim RE As Object, Matches As Object, UnMatch As Object
Dim s As String, decale As Integer
Dim SansMaj()

SansMaj = Array("du", "de", "d", "des", "van", "di", "del")

Set RE = CreateObject("VBScript.RegExp")
RE.Global = True 'Recherche toutes les correspondances
RE.IgnoreCase = True 'Ignore les différences maj/min

' Le pattern:
' De 0 à plusieurs caractères suivants: espace ou apostrophe ou tiret
' PUIS
' une suite de 1 à plusieurs lettres reconnues
RE.Pattern = "((s|'|-)*)" & _
"([A-ZßÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖØÙÚÛÜÝÞ]+)"

Set Matches = RE.Execute(LeTexte)

For Each UnMatch In Matches
With UnMatch
s = .SubMatches(2) ' le mot SANS les espaces/tirets/apostr situés
avant

If Left(s, 2) = "mc" Then ' De mcdonald vers mcDonald
decale = .FirstIndex + 1 + Len(.SubMatches(1)) + 2
Mid(LeTexte, decale, 1) = UCase(Mid(LeTexte, decale, 1))
End If

'met 1 lettre en maj sauf pour quelques mots SansMaj
If IsError(Application.Match(s, SansMaj, 0)) Then
' le mot s n'est pas dans la liste SansMaj
' donc, on met sa première lettre en maj
decale = .FirstIndex + 1 + Len(.SubMatches(1))
Mid(LeTexte, decale, 1) = UCase(Mid(LeTexte, decale, 1))
End If
End With
Next UnMatch

PremLettre = LeTexte
End Function

Salutations,

Daniel M.






Avatar
jps
:-))))))))))))))
merci aussi à to , clément, pour t'être passionné, à l'instar de daniel, sur
ces modifs qui, sans elles, ne feraient pas de ce travail un "bon" travail,
mais encore faut-il savoir s'il est exhaustif ; je crois me souvenir d'un
lointain voyage en Irian Jaya que les autochtones portent d'autres
particules mais comme ils n'ont pas de marteau, leurs problèmes n'ont même
pas la forme d'un clou....
jps

"Clément Marcotte" a écrit dans le message
de news:
Bonjour,

Comme j'ai vu que "d'ars" devenait "D'Ars" et que j'ai crains que tu
demandes une nouvelle modification pour "d'", j'ai don pris les
devants. Voici don où je suis rendu. (Et au diable les van, les di et
les del.)

Function PremLettre(LeTexte As String) As String
' met 1 lettre en maj sauf si "de","du","des", "d".
' changement au devis : JPS de + en + cap.......
'Daniel Maher mpfe
'modifiée par Clément Marcotte pour "des" et "d"
Dim RE As Object, Matches As Object, UnMatch As Object
Dim s As String, decale As Integer

Set RE = CreateObject("VBScript.RegExp")
RE.Global = True 'Recherche toutes les correspondances
RE.IgnoreCase = True 'Ignore les différences maj/min

' Le pattern:
' De 0 à plusieurs caractères suivants: espace ou apostrophe ou tiret
' PUIS
' une suite de 1 à plusieurs lettres reconnues
RE.Pattern = "((s|'|-)*)" & _
"([A-ZßÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖØÙÚÛÜÝÞ]+)"

Set Matches = RE.Execute(LeTexte)

For Each UnMatch In Matches
With UnMatch
s = .SubMatches(2)
If Left(s, 2) = "mc" Then ' De mcdonald vers mcDonald
decale = .FirstIndex + 1 + Len(.SubMatches(1)) + 2
Mid(LeTexte, decale, 1) = UCase(Mid(LeTexte, decale, 1))
End If
If (Left(s, 2) <> "de" And Left(s, 2) <> "du" And Left(s, 1) <> "d")
Or (Len(s) > 3) Then ' met 1 lettre en maj sauf si "de" ou "du"
decale = .FirstIndex + 1 + Len(.SubMatches(1))
Mid(LeTexte, decale, 1) = UCase(Mid(LeTexte, decale, 1))
End If
If Left(s, 3) <> "des" And Left(s, 1) <> "d" Then ' met 1 lettre en
maj sauf si "des"
decale = .FirstIndex + 1 + Len(.SubMatches(1))
Mid(LeTexte, decale, 1) = UCase(Mid(LeTexte, decale, 1))
End If
End With
Next UnMatch
PremLettre = LeTexte
End Function

P.S. Oublie mon autre réponse à ton "au secours"




Avatar
jps
je me lève en effet, clément, et c'est toi qui à ton réveil, trouveras ces
nouveaux remerciements pour ces commentaires...
merci encore
jps

"Clément Marcotte" a écrit dans le message
de news:
Bonjour,

Au moment où tu te lèves, je suis sur le point d'aller me coucher à
mon tour. Finalement, tu as le choix entre deux approches.

1) La procédure finale de Daniel est plus "compacte" et peut-être plus
efficace, mais, l'utilisation de la formule de feuille de calcul
"match" la rend difficilement utilisable en dehors d'Excel.

2) D'autre part, la procédure initiale de Daniel que j'ai modifiée est
plus longue et peut-être un peu moins performante. Mais elle reste
plus facilement exportable à l'extérieur d'Excel.

Donc conclusion, le choix final dépend un peu des besoins de
l'utilisateur. Mais si tu restes dans Excel, la procédure finale de
Daniel est joliment astucieuse.




Avatar
jps
vu, chef
jps

"Daniel.M" a écrit dans le message de
news:

JPS,
=== > >
je me réponds à moi-même avant d'aller dormir ; ben non, le And "des"
ne



marche pas et cela fait une 1/2 heure que je triture le 2, le 3, le
"des"



dans tous les sens sans parvenir à l'équivalent du "du" et du "de"....


Le 'And Left(s,3)<> "des" ' à l'INTÉRIEUR de la parenthèse devrait
marcher,



Pas vrai car les chaînes n'ont pas la même longueur.
Voir la réponse de Clément là-dessus (un peu plus loin de le fil).

Salutations,

Daniel M.






2 3 4 5 6