la première lettre majuscule est en 36ème position et a 15 lettres (c'est toujours les même cas)
Merci mapomme,ca marche.
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
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
D'ailleurs, je ne comprends pas ta manière d'utiliser le Pattern en le mettant dans un Array
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
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 ?
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
As-tu essayé ton jeton dans le cas de L'AGRAFE avec mon exemple ?Bonjour le fil, le forum
@Si...
...
Je n'utiliserai pas Excel (mais au hasard PowerShell ou VBscript)
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