Option Explicit
Dim regEx As Object 'mémorisation pour gagner du temps dans la création de l'objet ("VBScript.RegExp") 'job75
Function DissectNP(NP As String, x As Byte) As String
'- NP : la chaîne contenant le ou les NOMS + le ou les prénoms
'- x : si x = 1 --> NOMS
' si x = 2 --> Prénoms
'Magic_Doctor
Dim strPattern As String, LongueurNBNomsMaj As Integer, LongueurNBNomsFirstMaj As Integer
Dim PatternNoms As String, PatternPreNoms As String
Set regEx = CreateObject("VBScript.RegExp")
LongueurNBNomsMaj = NB_MotsMmFirstM(NP, 1, 2) 'somme des longueurs de tous les NOMS cherchés avec les espaces qui les sépare
LongueurNBNomsFirstMaj = NB_MotsMmFirstM(NP, 3, 2) 'somme des longueurs de tous les Prénoms cherchés avec les espaces qui les sépare
PatternNoms = "([A-ZÈÉÊËÄÇÆŒÁÍÓÚÂÊÎÔÛÄËÏÜÑ\.\-\?\s]{" & LongueurNBNomsMaj + 1 & "})" 'pattern des NOMS
PatternPreNoms = "([a-zçæéèíóúâêîôûäëïöüñA-ZÈÉÊËÄÇÆŒÁÍÓÚÂÊÎÔÛÄËÏÜÑ\.\-\?\s]{" & LongueurNBNomsFirstMaj & "})" 'pattern des Prénoms
strPattern = PatternNoms & PatternPreNoms
With regEx
.Global = True
.MultiLine = True
.IgnoreCase = False
.Pattern = strPattern
End With
If regEx.test(NP) Then
Select Case x
Case 1 'NOMS
DissectNP = regEx.Replace(NP, "$1")
Case 2 'Prénoms
DissectNP = regEx.Replace(NP, "$2")
End Select
Else
DissectNP = "Not matched"
End If
End Function
'
Function NB_MotsMmFirstM(phrase As String, x As Byte, Optional longueur As Byte = 0) As Integer
'Renvoie le nombre de mots, en MAJUSCULES ou en minuscules ou commençant par une MAJUSCULE suivie de minuscules, d'une phrase
'Magic_Doctor
'- phrase : la chaîne de caractères étudiée
'- x : si = 1 --> mots en MAJUSCULES
' si = 2 --> mots en minuscules
' si = 3 --> mots commençant par une MAJUSCULE suivie de minuscules
'- longueur : optionnel: "0" par défaut ---> nombre de types de mots cherchés
' si longueur = 1 ---> somme de la longueur de tous les types de mots cherchés (sans espaces)
' si longueur = 2 ---> somme de la longueur de tous les types de mots cherchés (avec espaces)
Dim tmp, nbmots As Integer, mot() As String, i As Integer, lemot As String, n As Byte, nbmm As Integer
Dim longword As Byte, longallwords As Byte
tmp = Split(phrase, " ")
nbmots = UBound(tmp) + 1 'nombre total de mots (quels qu'ils soient) dans la phrase
mot = Split(phrase)
For i = 1 To nbmots
lemot = mot(i - 1) 'Option Base 0
Select Case x
Case 1 'mots en MAJUSCULES
n = IIf(UCase(lemot) = lemot, 1, 0)
longword = IIf(UCase(lemot) = lemot, Len(lemot), 0)
Case 2 'mots en minuscules
n = IIf(LCase(lemot) = lemot, 1, 0)
longword = IIf(LCase(lemot) = lemot, Len(lemot), 0)
Case 3 'mots commençant par une MAJUSCULE suivie de minuscules
n = IIf(Left(lemot, 1) = UCase(Left(lemot, 1)) And Mid(lemot, 2, 1) = LCase(Mid(lemot, 2, 1)), 1, 0)
longword = IIf(Left(lemot, 1) = UCase(Left(lemot, 1)) And Mid(lemot, 2, 1) = LCase(Mid(lemot, 2, 1)), Len(lemot), 0)
End Select
nbmm = nbmm + n 'nombre de mots
longallwords = longallwords + longword 'somme des longueurs de tous les mots cherchés
Next
NB_MotsMmFirstM = IIf(longueur = 0, nbmm, IIf(longueur = 1, longallwords, longallwords + nbmm - 1))
End Function
,
