XL 2010 Problème avec une expression régulière

Magic_Doctor · 22 Mai 2021

Bonjour,

J'essaie de dompter le Pattern suivant :
Je veux découper une chaîne de caractères de telle sorte que seuls les mots commençant par une majuscule et précédés d'un espace aillent, avec les textes en minuscules qui les suivent, à la ligne dans une même cellule.
Exemple : Romina Gudule aux grands pieds Cunégonde la folle Úrsula
Romina
Gudule aux grands pieds
Cunégonde la folle
Úrsula

VB:

Sub SuperposerItemsChaine()

Dim cel As Range, c As Range

    Application.ScreenUpdating = False
    For Each cel In Selection
        cel = Application.WorksheetFunction.Trim(cel)  'suppression de tous les éventuels espaces superflus de la chaîne
        With CreateObject("VBScript.RegExp")
            .Pattern = "( )([A-ZÀ-Ÿ])"  'un espace suivi d'une lettre majuscule. Tient compte des majuscules diacritées
            .IgnoreCase = False
            .Global = True
            For Each c In cel
                c.Value = .Replace(c.Value, "$1" & Chr(10) & "$2")
            Next
        End With
    Next
    [C2500].Select: Application.ScreenUpdating = True
End Sub

J'ai pratiquement résolu le problème, mais je me heurte avec les mots en minuscules commençant par une voyelle diacritée comme à é í ú etc.
Comment résoudre ce problème ?

Magic_Doctor · 23 Mai 2021

Bonjour Yeahou,

Je n'avais pas vu ton post. Pas rafraîchi.
Comme quoi, l'art des Patterns est subtil.
Ce fil m'aura paru intéressant :
1/ avec du temps et de la patience on peut toujours trouver le bon Pattern,
2/ les RegExp sont lents.

Merci pour ton intervention. Comme on dit ici : sos un capo.
Que tengas un buen día.

Magic_Doctor · 23 Mai 2021

job75 à dit:
Elles ne sont pas lentes si l'objet n'est créé qu'une fois, voir le post #10.

Eh ! Eh ! C'est vrai que 5000, c'est beaucoup, surtout pour quelqu'un qui n'utilise JAMAIS de base de données ou de tableaux interminables.

Merci encore pour ton aide toujours instructive.

Bernard_XLD · 24 Mai 2021

Bonjour le fil, le forum

Magic_Doctor à dit:
Comme quoi, l'art des Patterns est subtil.
Ce fil m'aura paru intéressant :
1/ avec du temps et de la patience on peut toujours trouver le bon Pattern,

Oui, mais il n'y a pas plus puissant pour analyser une chaîne de caractères, les compilateurs et traducteurs sont tous basés sur les expressions régulières. C'est aussi pour cela qu'elles sont intégrées dans pratiquement tous les langages de programmation et fréquemment utilisées pour la vérification de la validité des mots de passe ou des adresses mail.

Bien cordialement et bonne journée, @+

patricktoulon · 1 Juin 2021

Bonjour à tous
heu.. désolé les gars mais perso avec le regex je vais plus vite que vous tous
testé sur le fichier de @job75
je met presque (pile poil) 2 fois moins de temps que la version sans regex de @job75
je met 2,5 fois moins de temps que la version avec regex
version sans regex 8.33 sec
votre version regex 11.58 sec
ma version 4.27
il faut dire que je travaille sur un tableau et non directement sur la cells a chaque tour
je sais même pas si le blocage du screenupdating va changer quelque chose ,je ne l'ai pas bloqué

et la fonction est réutilisable pour un autre travail unitaire ou tableau

VB:

Dim regex As Object
Sub testPatricktoulon()
    Dim motif$, i&, tablo, Tim#
    motif = "( )([A-ZÀ-Ý])"  'un espace suivi d'une lettre majuscule. Tient compte des majuscules diacritées
    'test sur un tableau
    tablo = [Source].Offset(7).Resize(5000).Value
    Tim = Timer
    For i = 1 To UBound(tablo)
        tablo(i, 1) = coupeItemChaine(CStr(tablo(i, 1)), motif)
    Next
    '-------------------------
    Cells(10, "B").Resize(5000).Value = tablo

    MsgBox "temps de travail: " & Format(Timer - Tim, "0.00 \sec")
    Set regex = Nothing
End Sub

Function coupeItemChaine(cel As String, PatternX, Optional Lacase As Boolean = False, Optional Globale As Boolean = True)
    If regex Is Nothing Then Set regex = CreateObject("VBScript.RegExp"): regex.IgnoreCase = Lacase: regex.Global = Globale: regex.Pattern = PatternX
    coupeItemChaine = regex.Replace(Trim(cel), "$1" & Chr(10) & "$2")
End Function

job75 · 1 Juin 2021

Bonjour patricktoulon, le forum,

Tu ne compares pas avec le bon fichier, c'est le fichier (2) de mon post #10 qu'il faut utiliser.

Chez moi ta solution n'est pas plus rapide => 1,75 seconde.

A+

patricktoulon · 1 Juin 2021

re
bonjour @job75

la version regex du post 10

ta version sans regex du post 10

et ma version du regex

Etoto · 1 Juin 2021

patricktoulon à dit:
re
bonjour @job75

la version regex du post 10
Regarde la pièce jointe 1107165

ta version sans regex du post 10
Regarde la pièce jointe 1107168

et ma version du regex
Regarde la pièce jointe 1107167

Bonjour à tous,

Tu as une macro qui permet de savoir le temps d'exécution d'une autre macro ? Elle fonctionne comment ? Si je peux me permettre.

patricktoulon · 1 Juin 2021

re
Bonjour @Etoto
ben c'est simple
avant la boucle tu met Tim= timer
après la boucle et le transfert sur cells tu met msgbox format((timer-tim),"0.00 /sec")
j'ai rien inventé
tout le monde ou presque fait comme ça

Etoto · 1 Juin 2021

patricktoulon à dit:
re
Bonjour @Etoto
ben c'est simple
avant la boucle tu met Tim= timer
après la boucle et le transfert sur cells tu met msgbox format((timer-tim),"0.00 /sec")
j'ai rien inventé
tout le monde ou presque fait comme ça

Oui mais depuis le temps que je suis dans ce forum, je suppose que tu connais mon niveau en VBA .

patricktoulon · 1 Juin 2021

re
y a pire t'inquiet

XL 2010 Problème avec une expression régulière

Magic_Doctor

XLDnaute Barbatruc

Pièces jointes

Magic_Doctor

XLDnaute Barbatruc

Magic_Doctor

XLDnaute Barbatruc

Bernard_XLD

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Etoto

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Etoto

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc