Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

Créer une discussion

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire

Magic_Doctor

XLDnaute Barbatruc
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 ?
 

Pièces jointes

Dernière édition:
Trier par date Trier par votes
Bonjour Magic_Doctor,

Avec ce code plus de problème :
VB: 
Sub Copier_Coller()
    [Source].Offset(7) = [Source].Value
End Sub

Sub SuperposerItemsChaine()
Dim majuscules$, c As Range, t$, i%
    majuscules = "ABCDEFGHIJKLMNOPQRSTUVWXYZÀÁÂÃÄÅÒÓÔÕÖØÈÉÊËÌÍÎÏÙÚÛÜÑÇ"
    Application.ScreenUpdating = False
    For Each c In Selection
        t = " " & Application.Trim(Replace(c, vbLf, " "))
        For i = Len(t) To 2 Step -1
            If InStr(majuscules, Mid(t, i, 1)) And Mid(t, i - 1, 1) = " " Then t = Left(t, i - 2) & vbLf & Mid(t, i): i = i - 1
        Next i
        c = Mid(t, 2)
    Next c
    [C2500].Select
End Sub
A+
 

Pièces jointes

Vote positif 0 Vote négatif
Bonjour job75,

je crois bien que Magic_Doctor (salut) veut absolument utiliser les expressions régulières, donc avec ceci :​

With CreateObject("VBScript.RegExp")

c'est car il fait des exos persos sur regexp : il veut obtenir son Doctorat Regexp, maîtrise Expert. 😜​

soan
 
Vote positif 0 Vote négatif
@job75 (salut Lionel)

oh oui, moi aussi, je trouve que c'est mieux si on peut éviter les regexp ! 😊

par contre, je ne maîtrise pas les désirs de Magic_Doctor ! 😁

ce que femme veut Magic_Doctor veut... 🤪


et puis sinon, j'aurais déjà proposé un fichier Excel depuis longtemps !

mais les regexp et moi, ça fait 2 ! 😄

soan
 
Vote positif 0 Vote négatif
Maintenant Magic_Doctor si tu tiens aux RegExp utilise ce fichier (2) :
VB: 
Sub Copier_Coller()
    [Source].Offset(7) = [Source].Value
End Sub

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" & vbLf & "$2")
            Next
        End With
    Next
    [C2500].Select
End Sub
 

Pièces jointes

Vote positif 0 Vote négatif
@job75

j'adore ta comparaison des temps et l'info de ton Nota ! 👍 🙂

j'espère que Lionel (salut) ne sera pas jaloux si je t'ai attribué un "J'adore" :
d'habitude, c'est lui qui te met des "Like" ! 😜 😄

(j'ai quelques scrupules à remplacer ton fan préféré ! 🤣)​

soan
 
Dernière édition:
Vote positif 0 Vote négatif
Voici les bonnes méthodes, avec utilisation d'un tableau VBA, fichier (2) :
VB: 
Sub Copier_Coller()
    [Source].Offset(7) = [Source].Value
    With [Source].Offset(7).Resize([Source].Rows.Count)
        .AutoFill .Resize(1000 * .Rows.Count)
    End With
End Sub

Sub SuperposerItemsChaine_Avec_RegExp()
Dim dur, o As Object, tablo, i&, t$
dur = Timer
    Set o = CreateObject("VBScript.RegExp")
    o.IgnoreCase = False
    o.Global = True
    o.Pattern = "( )([A-Z]|[ÀÁÂÃÄÅÒÓÔÕÖØÈÉÊËÌÍÎÏÙÚÛÜÑÇ])"  'un espace suivi d'une lettre majuscule. Tient compte des majuscules diacritées
    With [Source].Offset(7).Resize(1000 * [Source].Rows.Count)
        tablo = .Value 'matrice, plus rapide
        For i = 1 To UBound(tablo)
            t = Application.Trim(Replace(tablo(i, 1), vbLf, " "))
            tablo(i, 1) = o.Replace(t, "$1" & vbLf & "$2")
        Next
        .Value = tablo
    End With
MsgBox "Durée " & Format(Timer - dur, "0.00 \sec")
End Sub

Sub SuperposerItemsChaine_Sans_RegExp()
Dim dur, majuscules$, tablo, i&, t$, j%
dur = Timer
    majuscules = "ABCDEFGHIJKLMNOPQRSTUVWXYZÀÁÂÃÄÅÒÓÔÕÖØÈÉÊËÌÍÎÏÙÚÛÜÑÇ"
    With [Source].Offset(7).Resize(1000 * [Source].Rows.Count)
        tablo = .Value 'matrice, plus rapide
        For i = 1 To UBound(tablo)
            t = " " & Application.Trim(Replace(tablo(i, 1), vbLf, " "))
            For j = Len(t) To 2 Step -1
                If InStr(majuscules, Mid(t, j, 1)) And Mid(t, j - 1, 1) = " " Then t = Left(t, j - 2) & vbLf & Mid(t, j): j = j - 1
            Next j
            tablo(i, 1) = Mid(t, 2)
        Next i
        .Value = tablo
    End With
MsgBox "Durée " & Format(Timer - dur, "0.00 \sec")
End Sub
Les 2 méthodes sont équivalentes => 1,80 seconde sur 5000 lignes chez moi.
 

Pièces jointes

Vote positif 0 Vote négatif
Bonjour le fil, le forum

@Magic_Doctor , tu n'étais vraiment pas loin, un caractère 221 au lieu d'un caractère 159 et ça aurait fonctionné comme tu le voulais !

Bien cordialement, @+
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
 
Vote positif 0 Vote négatif
Bonjour Yeahou,

Ah c'est bien vu, il fallait le trouver ce Ý.

J'ai vérifié, le Pattern récupère bien tous les caractères accentués, y compris Å Ø Ñ Ç.

Cela dit par rapport à la liste en dur la durée d'exécution est inchangée.

A+
 
Vote positif 0 Vote négatif
Bonjour job,

Merci pour tes prouesses. L'essentiel, c'est le résultat, peu importe la méthode.
En revanche, il est intéressant de constater à quel point les RegExp sont lentes.

Sacré soan ! Potache un jour, potache toujours ! 😂 😂 😂
 
Dernière édition:
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…