chaine de caractère

lynyrd

XLDnaute Impliqué
Bonsoir le forum.
j'aimerais trouver les majuscules,et les remettre dans la cellule suivante.
Merci.
 

Pièces jointes

  • majuscule.xlsx
    9.5 KB · Affichages: 31

laurent950

XLDnaute Accro
Bonsoir,

ATTACH=full]1009895[/ATTACH] Bonsoir,

Ne pas Oublier de cocher

ExpressionReguliereRegex.JPG
' Pour Instancie les variables !
' Cocher la case à côté de "Microsoft VBScrit Regular Expressions 5.5" à inclure dans votre classeur.
' C'est dans la boite a Outils VBA

Voici le code qui marche peux importe le nombre de lettre de 1 à 17 qui se suivent.

Uniquement pour 16 caractéres qui se suivent, C'est pour cela que j'ai mis un de plus donc
17 dans mon exemple mais si il y en 18 cela fonctionne plus avec la macro donc augmenter a 18
{1,17} passer à 18 donc {1,18}
toutes les combinaisons sont prise en comptes de 1 à 18 qui se suivent Ect.
J'explique plus bas dans mon code
Merci mapomme,ca marche.


VB:
Sub ExtractMaj_B1()
'http://dedeuf.free.fr/Faq/php/exp_regulieres.htm
''''' http://www.loribel.com/info/memento/regex.html
' http://www.loribel.com/info/memento/regex.html
'https://www.lucaswillems.com/fr/articles/25/tutoriel-pour-maitriser-les-expressions-regulieres
' Trouve le Mot Exacte de la chaine !

'Il faut substitué cette ligne par cette ligne :
'qui fonctionne en local sur la feuille active.

'*** ------------------------------------------------------------------------------
' Instancie les variables !
' Cocher la case à côté de "Microsoft VBScrit Regular Expressions 5.5" à inclure dans votre classeur.
    Dim reg As VBScript_RegExp_55.RegExp
    Dim Match As VBScript_RegExp_55.Match
    Dim Matches As VBScript_RegExp_55.MatchCollection

'*** ------------------------------------------------------------------------------
' Phrase rechercher dans excel ici cellule B1!!
Dim Phrase As String
Phrase = Cells(1, 2)

'*** ------------------------------------------------------------------------------
' Tableaux des expression reguliéres !!
' Ici le nombre de lettres majuscule qui se suivent soit : {1,17}   exemple : Ont peux mettre plus {1,34}
1  exp A ou 1 et 2 : Exp : AB ou 1 à 3 Exp : ABC jusqu'a 1 à 17 soit sont exemple : SGYBOYHOITCUXJCK

Tabqts = Array("[A-Z]{1,17}")

For i = LBound(Tabqts, 1) To UBound(Tabqts, 1)
' instanciation
Set reg = New VBScript_RegExp_55.RegExp
    ' A-1. Les propriétés.
    ' -------------------
        reg.Pattern = Tabqts(i)
        ' Active ou non la recherche sur plusieurs lignes à la fois / La propriété est mise sur False par défaut / Multiline (booléen).
            reg.MultiLine = False
        ' Précise si la recherche est sensible ou non à la casse (majuscules/minuscules) / La propriété est mise sur False par défaut / IgnoreCase (booléen).
            reg.IgnoreCase = False
        ' Précise si la recherche porte sur la première occurence ou sur toutes / La propriété est mise sur False par défaut.
            reg.Global = True
    ' A-2. Les méthodes.
    ' -----------------
        'le .Test renvoie True si le motif défini en Pattern est trouvé dans la chaîne / Test (validation).
            ' MsgBox reg.Test(Phrase)
'*** ------------------------------------------------------------------------------
    ' Cette méthode permet d'explorer les occurences qui vérifient le Pattern / Execute (exploration).
    ' Resultat
    If reg.Test(Phrase) = True Then
        Set Matches = reg.Execute(Phrase)
            For Each Match In Matches
                Debug.Print "source >>", Match.Value
'                For j = 0 To Match.SubMatches.Count - 1
'                    Debug.Print "[$" & j + 1 & "]", Match.SubMatches(j)
'                Next j
'           cellule c1 = Cells(1, 3)
            Cells(1, 3) = Trim(Match.Value)
            Next Match
    ' si trouvé sort de la boucle
    Exit For
End If
Next i
End Sub

Ps : J'ai laissé les adresses des sites pro qui explique un peux le principe est concepts des Regex pas très simple mais
super puissant (C'est dans les modules) que j'ai laissé pour comprendre.

En espérant que cela répondent à vos besoins

laurent
 

Pièces jointes

  • ExtractionMajusculeRegex.xlsm
    22.4 KB · Affichages: 30
Dernière édition:

Staple1600

XLDnaute Barbatruc
Bonsoir le fil, le forum, mapomme;)

Une autre formule (pour rester dans le K.I.S.S)
(C'est juste au cas zou, les 36 chandelles ne seraient pas 36 ;) )
=STXT(B1;3+CHERCHE("?q=";B1);16)

NB: laurent950 (merci d'avoir laisser tes liens dans tes commentaires)
Personnellement, je préfère ici passer par une formule que de sortir l'artillerie lourde ;)

D'ailleurs, je ne comprends pas ta manière d'utiliser le Pattern en le mettant dans un Array

Ci-dessous une fonction personnalisée (adaptée de mes archives)
A utiliser ainsi: =X_MAJU(B1)
VB:
Function X_MAJU(text As String) As String
Static RgExp As Object
Dim oMatches As Object, oMatch As Object, s$
If RgExp Is Nothing Then
    Set RgExp = CreateObject("VBScript.RegExp")
End If
With RgExp
    .IgnoreCase = False: .Global = True: .Pattern = "\b([A-Z]+)"
    If .test(text) = True Then
        Set oMatches = .Execute(text)
        For Each oMatch In oMatches
            s = s & oMatch
        Next
    End If
End With
If s <> "" Then X_MAJU = s
Set oMatches = Nothing
End Function

Mais puisque les formules natives d'Excel peuvent faire le job, pourquoi sortir VBA?
 

laurent950

XLDnaute Accro
D'ailleurs, je ne comprends pas ta manière d'utiliser le Pattern en le mettant dans un Array

Bonjour Staple1600
en fait c'est pour combiner plusieurs Pattern et pouvoir les stocker dans une variable tableau.
ici aucune utilité sauf s'il y avait un autre type de chaîne de caractères à chercher dans cette phrase.

donc l'utilité d'un tableau sera pour stocker les Pattern (bien sur à écrire) et régler une boucle et les procédures

je n'ai pas modifié et laissé ainsi ! au cas où... il y a un début de code, pour une future suite du fils et surtout l'idée qui faudra adapter

Ps : Vous êtes hyper fort j'ai appris beaucoup ici est avec plaisir d'aider aussi à mon tour lorsque je suis assez compétent pour trouver des solutions

Merci


Laurent
 

Staple1600

XLDnaute Barbatruc
Re

@laurent950
Merci pour les explications.

Dans le cas présent, je reste partisan d'aller au plus simple: l'emploi d'une formule.

L'emploi de VBA, ici, (à mon sens, qui donc n'engage que moi), c'est pour se faire plaisir ou pour un petit challenge RegExp d'avant week-end. ;)

PS: Je suis pas hyperfort.
J'ai juste passé trop temps derrière un clavier.
Et je n'ai pas su résister aux attraits de la Cellule du Grand Tableur de Redmond, rencontré par hasard du temps où on l'appelait XL 4. ;)
 

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonsoir à lautent950 :), Staple1600 ;), à tous,

En restant dans la petite artillerie VBA, une fonction qui retourne le premier groupe de lettres majuscules contigües quelque soit sa position :
VB:
Function PremMotMaj(x As String) As String
Dim i&, j&
   For i = 1 To Len(x)
      If Asc(Mid(x, i, 1)) >= 65 And Asc(Mid(x, i, 1)) <= 90 Then
         For j = i + 1 To Len(x)
            If Asc(Mid(x, j, 1)) < 65 Or Asc(Mid(x, j, 1)) > 90 Then Exit For
         Next j
         PremMotMaj = Mid(Left(x, j - 1), i)
         Exit For
      End If
   Next i
End Function
 

Pièces jointes

  • lynyrd- majuscule- v1.xlsm
    15.6 KB · Affichages: 29

Staple1600

XLDnaute Barbatruc
Re

@mapomme
Bon alors je sors mon petit pistolet ;)
VB:
Function X_MAJU2(S$) As String
With CreateObject("VbScript.RegExp")
    .Pattern = "\b[A-Z]+"
    If .Test(S) = -1 Then
    Set matches = .Execute(S): X_MAJU2 = matches(0).Value
    End If
End With
End Function

Mais on est bien d'accord.
Nous sommes déraisonnables, non ?
 

Si...

XLDnaute Barbatruc
Bon_jour
...
Mais on est bien d'accord.
Nous sommes déraisonnables, non ?

Si j'étais Moi :D, Staple, je ne penserais pas comme Toi :p! Je me demanderais dans quel contexte j'évolue et notamment si une quantité énorme de formules* ne vient pas ralentir le 'générique'.

VB:
 Private Sub Worksheet_SelectionChange(ByVal R As Range)
  If Not Intersect(R, Range("C1", "C3")) Is Nothing And R.Count = 1 Then
      Application.Calculation = xlCalculationManual
      R.FormulaR1C1 = "=MID(RC[-1],36,16)": R = R.Value
      Application.Calculation = xlCalculationAutomatic
  End If
End Sub



* dans ce cas contraire, tu sais quelles lignes tu peux enlever, non ?
 

Pièces jointes

  • FormuleVBA.xlsm
    18 KB · Affichages: 21

laurent950

XLDnaute Accro
Bonjour le fils,
Même code en sans exploiter la variable tableau a tester TOP aussi. juste a récupérer toutes les majuscules la chaine.
cela offre de multiples possibilitées d’extraction si ont choisie un autres critère de REGEX a intégrer à la variable tableau

Laurent
 

Pièces jointes

  • ExtractionMajusculeRegex (2).xlsm
    22.7 KB · Affichages: 32

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonsoir à tous ;),

Je persiste et signe pour du VBA (il faut reconnaître ses limites : je ne me ferais jamais aux langage concis comme REGEXP dont on ne sait jamais si le résultat obtenu est le résultat souhaité dans tous les cas tellement la concision fait ressembler les instructions à du charabia). Mais je reconnais sa puissance et son efficacité :p et son emploi pratiquement obligatoire dans les expressions très complexes.

Comme on est ici dans un cas de figure simplissime, voila deux fonctions VBA :
  • MotMajTablo(x) qui renvoie une chaine des termes en majuscule dans x ; termes séparés par le caractère saut de ligne
  • MotMajNieme(x,xn) qui renvoie le xn ième mot en majuscule de la chaine x (si xn omis, alors xn est mis à 1)
VB:
Function MotMajTablo(ByVal x As String) As String
Dim i&, n&
   For i = 1 To Len(x)
      n = Asc(Mid(x, i, 1))
      If n < 65 Or n > 90 Then Mid(x, i, 1) = " "
   Next i
   x = Application.WorksheetFunction.Trim(x)
   MotMajTablo = Replace(x, " ", Chr(10))
End Function

Function MotMajNieme(ByVal x As String, Optional xn As Long = 1) As String
   On Error Resume Next
   If IsMissing(xn) Then xn = 1
   xn = Abs(xn)
   MotMajNieme = Split(MotMajTablo(x), Chr(10))(xn - 1)
End Function
 

Pièces jointes

  • lynyrd- majuscule- v3.xlsm
    21.1 KB · Affichages: 25

Discussions similaires

Statistiques des forums

Discussions
312 198
Messages
2 086 151
Membres
103 133
dernier inscrit
mtq