Recherche dans une chaine de caractère + extraction de la donnée

MERLIN

XLDnaute Junior
Bonjour à toutes et à tous,

Je suis devant une impasse car cette partie d'excel m'est pour l'instant complètement inconnue !
J'ai un tout un fichier à analyser et je dois extraire "une simple donnée", le numéro de téléphone portable contenu dans une chaine de caractères !

J'ai mis un fichier en exemple. J'imagine qu'il doit exister une belle boucle (ça je sais faire) avec une fonction de recherche + extraction (ça je ne sais pas du tout faire).

Un gros merci d'avance à celles et à ceux qui se pencheront sur mon cas.
 

Pièces jointes

  • Extraction du mobile.xls
    24.5 KB · Affichages: 72

job75

XLDnaute Barbatruc
Bonjour le fil, le forum,

Il y a une chose que peu de gens semblent avoir intégré : la création de l'objet RegExp prend du temps et avec une fonction entrée dans un grand nombre de cellules (10 ou 20000) c'est insupportable.

Pour y remédier il suffit de mémoriser l'objet :
Code:
Dim o As Object 'mémorisation pour gagner du temps sur la création

Function ExtractTelPortable(maChaine As String, pos As Long, sep As String, Optional tel As Boolean = True) As String
Dim s As String
On Error GoTo Exit_Function
If o Is Nothing Then
  Set o = CreateObject("VBScript.RegExp")
  o.Pattern = "\b\d(\d| )*\b"
  o.Global = True
  s = o.Execute(maChaine)(pos - 1)
End If
ExtractTelPortable = Replace(IIf(tel Xor (Not s Like "0*"), s, ""), " ", sep)
Exit_Function:
End Function
https://www.excel-downloads.com/thr...nction-dun-intervalle.20013756/#post-20103355

A+
 

Magic_Doctor

XLDnaute Barbatruc
Bonjour job, le forum,

M'initiant depuis peu à ces histoires d'expressions régulières, je reconnais qu'en général, dans les quelques procédures que j'ai pu lire, l'objet Pattern est déclaré et mémorisé dès le début de la procédure.
J'ai repris textuellement la routine qu'aimablement pgc01 m'avait rédigée, et j'avais été étonné que le l'objet Pattern n'ait pas été déclaré dès le départ. Je me suis dit, "tiens, une variable de moins déclarée..." Mais en fait, chaque fois il faut recréer cet objet, puisqu'il n'a pas été mémorisé. C'est sûr que quand on le recréé 10.000 fois d'affilé... :eek:

Mais si quelqu'un pouvait m'expliquer pourquoi ma fonction déconne. Question d'honneur... :)
 

Pièces jointes

  • Pattern Forum (7).xlsm
    27.8 KB · Affichages: 21

job75

XLDnaute Barbatruc
Bonjour Magic_Doctor,

Ta fonction plante parce que l'objet o n'est pas déclaré en haut du module (mon message précédent).

Par ailleurs créer la fonction SingleSpaceBetweenWonderfulWords est une pure hérésie.

Car il y a la fonction Application.Trim : c'est la fonction Excel SUPPRESPACE (ESPACIOS).

A+
 

Magic_Doctor

XLDnaute Barbatruc
Re,

Tu as tout à fait raison, job. Mais je pensais que "Trim" virait uniquement les espaces en début et fin de chaîne. Autant pour moi !
Mais reconnaissons que "SingleSpaceBetweenWonderfulWords" ça en jette !

Je faisais allusion à une autre fonction (celle-ci n'étant pas de moi) ; celle du post #17, que j'avais rédigée, en désespoir de cause, ne sachant plus quoi faire evec les expressions régulières.

Enfin, je viens de mettre, dans la procédure où tu viens d'intervenir, "Dim o As Object" sous "Option Explicit" (c'est bien ce que j'aurais dû faire ?). La fonction ne me renvoie plus rien. Où me serais-je encore planté ?
 

job75

XLDnaute Barbatruc
Re,

Bah j'ai fait une erreur grossière dans la fonction que j'ai mise au post #32.

Le End If est mal placé, il faut le mettre bien sûr avant o.Execute :
Code:
Dim o As Object 'mémorisation pour gagner du temps sur la création

Function ExtractTelPortable(maChaine As String, pos As Long, sep As String, Optional tel As Boolean = True) As String
Dim s As String
On Error GoTo Exit_Function
If o Is Nothing Then
  Set o = CreateObject("VBScript.RegExp")
  o.Pattern = "\b\d(\d| )*\b"
  o.Global = True
End If
s = o.Execute(maChaine)(pos - 1)
ExtractTelPortable = Replace(IIf(tel Xor (Not s Like "0*"), s, ""), " ", sep)
Exit_Function:
End Function
A+
 

laurent950

XLDnaute Accro
Bonjour Magic,

J'ai substitué la fonction sélect case, c'est peux être plus simple de codé en tableau.
Le principe est bien là, je récupère à présent les numéros de téléphones en fonction des conditions.
Par contre il faut étudier les positions des numéros de téléphones dans l'ordre de la phrase en fonction du numéro de position choisie par votre fonction, je n'en suis pas encore arrivé là mais j'ai l'idée je vais y arriver.
Est ce que ce début de code vous semble plus claire ?

Le soucis de la fonction CreateObject("vbscript.regexp") restitue la cible ou les cibles sous forme de tableau mais pas dans un ordre. c'est a dire que :
ce numéro de téléphone : 094 54 20 44 ---->>> à la position Numéro 2 dans la phrase mais qui en réalité et enregistré dans une variable tableau qui correspond a un autre numéro 0 pour la recherche CreateObject("vbscript.regexp") C'est a dire qu'il faut trouver une relation par la suite.
a creuser !

je ferais quelque choses avec cela plus tard d'ou mon idée mais a creuser encore !
' Debug.Print "[$" & j + 1 & "]", TabMatch(i).SubMatches(j)
'Debug.Print TabRch(i), TabMatch(i).SubMatches(j)


VB:
Option Base 1
Sub Laurent1()
' initianlisation des variables
Dim Chaine As String
'Pitaluga a plusieurs Nº de téléphone : 06 66 99      55 76  &  094 54 20 44  &  099    925 301  &  06 300 200 11
    Chaine = "Pitaluga a plusieurs Nº de téléphone : 06 66 99      55 76  &  094 54 20 44  &  099    925 301  &  06 300 200 11"
' C'est la propriété qui définit le motif sur lequel se fait la recherche.
    'strPattern = "\d{2}\s"    '2 chiffres & espace(s)
    'strPattern = "\d{2,3}\s"  '2 ou 3 chiffres & espace(s)
    'strPattern = "\d{3}\s"    '3 chiffres & espace(s)
'TabRch = Array("(\d{2}\s{1,6}){5}", "(\d{2,3}\s\*{4})", "(\d{3}\s\*{3})")
'TabRch = Array("(\d{2}\s{1,6}){5}", "(\d{2,3}\s){4}", "(\d{3}\s{1,4}){3}")
TabRch = Array("(\d{2}\s*){5}", "(\d{2,3}\s*){4}", "(\d{3}\s*){3}")

'*** ------------------------------------------------------------------------------
' Tableau d'objet
Dim Tabreg() As Object
ReDim Tabreg(LBound(TabRch) To UBound(TabRch))
Dim TabMatch() As Object
ReDim TabMatch(LBound(TabRch) To UBound(TabRch))
Dim TabMatches() As Object
ReDim TabMatches(LBound(TabRch) To UBound(TabRch))
'*** ------------------------------------------------------------------------------
For i = LBound(Tabreg) To UBound(Tabreg)
    Set Tabreg(i) = CreateObject("vbscript.regexp")
        ' ici laissé pour l'ordre !
        'Chaine = "Pitaluga a plusieurs Nº de téléphone : 06 66 99      55 76  &  094 54 20 44  &  099    925 301  &  06 300 200 11"
        'Le Pattern est le motif que l'on recherche
        Tabreg(i).Pattern = TabRch(i)
        ' Active ou non la recherche sur plusieurs lignes à la fois / La propriété est mise sur False par défaut.
        Tabreg(i).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.
        Tabreg(i).IgnoreCase = True
        ' Précise si la recherche porte sur la première occurence ou sur toutes / La propriété est mise sur False par défaut.
        Tabreg(i).Global = True
        'le test renvoie un Boolean (parfait pour notre fonction Booléenne!!!)
        MsgBox Tabreg(i).test(Chaine)
        ' Cette méthode permet d'explorer les occurences qui vérifient le Pattern.
        Set TabMatches(i) = Tabreg(i).Execute(Chaine)
            For Each TabMatch(i) In TabMatches(i)
                Debug.Print "source >>", TabMatch(i).Value
                    For j = 0 To TabMatch(i).SubMatches.Count - 1
                        ' Debug.Print "[$" & j + 1 & "]", TabMatch(i).SubMatches(j)
                        'Debug.Print TabRch(i), TabMatch(i).SubMatches(j)
                Next j
            Next TabMatch(i)
Next i
'*** ------------------------------------------------------------------------------
End Sub

Ps : C'est très intéressante mais pas si simple mais je cherche aussi, au plaisir de partager avec vous
aussi le code est en dur donc pour test est compréhension j'adapterais plus tard au donné lié à votre feuille excel en relation avec votre fonction

Laurent
 
Dernière édition:

Magic_Doctor

XLDnaute Barbatruc
Bonjour laurent950,

Je ne sais pas si vous avez téléchargé la PJ de mon dernier post.
Je pense que le problème est réglé par le biais d'un "Pattern" ad hoc (entre nous, il fallait le trouver celui-là... quand on ne maîtrise pas ce type de syntaxe). Quelle que soit la chaîne, les numéros sont prélevés théoriquement suivant que ce soient des portables ou des postes fixes.
Je dis théoriquement, parce que j'avais complètement oublié qu'en France les numéros de postes fixes commencent eux aussi par "0", comme ceux des portables. Bon, on ne va pas refaire le monde, mais n'aurait-il pas été plus simple :
- numéros qui commencent par 0 --> portables
- numéros qui commencent par un autre chiffre --> poste fixe
Comme ici en Uruguay.
Et qu'on ne me dise pas que ce n'était pas possible ! Après tout, on a bien marché sur la lune...
Au jour d'aujourd'hui, il me semble qu'en France (Wikipedia) les numéros de portables peuvent commencer par "06" ou "07" (le ou les Nº qui suivent sont des caractéristiques de l'opérateur).
Donc, le casse-tête continue. Mais c'est en effet et intéressant (j'aurais appris des choses) et amusant. D'autant plus que ça ne sert à rien...
Pour résumer, la procédure de la PJ marche très bien pour l'Uruguay, mais pour la France, ce n'est pas encore gagné.
À noter que le classement des numéros, suivant qu'ils soient dédiés à des portables ou pas, n'a en fait que peu d'importance. L'essentiel est de récupérer ces numéros tout en les distingant.
 
Dernière édition:

laurent950

XLDnaute Accro
J'espère avoir réglé le problème pour la France.

Je pense que l on peux tous identifié, j'ai fait une approche avec le pattern (pas simple a composé !)

Vous pouvez m'ecrire des series de numéro de téléphone :
06 00 00 00 00 (ici portable france)
07 00 00 00 00 (ici portable france)
01 00 00 00 00 (ici fixe france)
08 00 00 00 00 (ici fixe france)
0 000 000 000 (ici numero speciaux 10 chiffres france)
Indicatif france = +33 (remplace le 0 de 06 soit +33 6 00 00 00 00) et le + signifie le double 00 donc ont peux aussi ecrire en remplacent le +par le double 00 et en conservant le 33 par la suite donc (0033 6 00 00 00 00 Ou 00 33 6 00 00 00 00 etc.)
Cela fait plusieurs combinaisons qu'il faut identifier dans la chaine puis aussi qui peux être ecrite de différente manière comme ci-dessus)
Donc le reglage du Pattern est essentiel et il faut lister les différentes combinaisons.
Avec une liste de numéros que vous avez ont peux retrouver ces différents groupes et les isoler de la chaine et trouver une correspondance.
Je ferais cela par la suite.

Ps : vous pouvez noter le Patern ad hod dans votre réponse s'il vous plait ?

Merci pour ces echanges fort intéressent

Laurent950
 

job75

XLDnaute Barbatruc
Bonjour Magic_Doctor, laurent950 et tutti quanti,
¡Ay Caramba! Mais pourquoi ma fonction (Post #17) ne marche pas ?
Parce que le code de ta fonction nécessite que tu bornes la chaîne :
Code:
    maChaine = SingleSpaceBetweenWonderfulWords(maChaine) & "a" 'chaîne bornée
Le fichier du post #17 en retour.

A+
 

Pièces jointes

  • Pattern Forum (5+++).xlsm
    27 KB · Affichages: 29

Magic_Doctor

XLDnaute Barbatruc
Bonjour job, laurent, le forum,

Merci job pour avoir étudié ma fonction, même si maintenat elle est devenue caduque.
Le "bornage" des chaînes, ça je ne connaissais pas. En tout cas, tu auras été le seul à m'avoir répondu sur la planète "Terre", puisque je suis allé loin, très loin pour exposer le problème (Staple pourra confirmer).

@laurent

Pour le "Pattern", il suffit de regarder dans la macro. C'est celui-ci : o.Pattern = "\b\d(\d| )*\b"
 

Discussions similaires