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

Magic_Doctor

XLDnaute Barbatruc
N'y arrivant pas avec la stratégie que j'avais choisie, j'ai décidé de changer le fusil d'épaule.
J'ai donc rédigé cette fonction :
VB:
Function ExtractTelPortable(maChaine As String, x As Byte, sep As String, Optional tel As Boolean = True) As String
'Extraie des séries de Nº d'une chaîne
'- maChaine : la chaîne contenant des séries de Nº
'- x : position du Nº que l'on recherche dans la chaîne
'- sep : séparateur que l'on veut placer entre les groupes de chiffres d'un même Nº
'- tel : par défaut "True" (--> portables). Si "False", alors il s'agit de Nº de postes fixes

'J'ai privilégié les portables, car je pense que les postes fixes sont voués à disparaître... It's good for Big Brother!
'Et pour bien nous casser les couilles quand on arrive en France et que l'on ne peut prévenir personne à la Gare du Nord où il n'y a plus une seule cabine téléphonique...!!!

Dim MesBoSep, a, n As Byte, i As Integer, j As Integer, trouve As String, cadena As String

    '*************** Épurage de la chaîne initiale ***************
    MesBoSep = Array(".", ",", ";", "-", "/", "|", "~", "*", "+")
    For Each a In MesBoSep
        maChaine = Replace(maChaine, a, " ")
    Next
    maChaine = SingleSpaceBetweenWonderfulWords(maChaine)
    '*************************************************************
  
    For n = 1 To x
        For i = 1 To Len(maChaine)
            trouve = Mid(maChaine, i, 1)
            If IsNumeric(trouve) Then
                maChaine = Right(maChaine, Len(maChaine) - i + 1) 'on supprime tout ce qui n'est pas numérique à gauche de la chaîne
                For j = 1 To Len(maChaine)
                    trouve = Mid(maChaine, j, 1)
                    If trouve <> " " And IsNumeric(trouve) = False Then
                        cadena = Trim(Left(maChaine, j - 1)) 'on récupère uniquement la 1ère série de chiffres (à gauche) de "maChaine" : celle qui nous intéresse
                        maChaine = Mid(maChaine, Len(cadena) + 1, Len(maChaine) - Len(cadena)) '"maChaine" est amputée de sa 1ère série de chiffres
                        Exit For
                    End If
                Next
                Exit For
            End If
        Next
    Next
  
    If sep = "Nada" Then sep = "" 'facultatif. Ici, uniquement pour les besoins de la liste déroulante de la feuille où "Nada" = rien du tout
  
    If tel Then 'on ne veut récupérer que les Nº de portables
        ExtractTelPortable = IIf(Left(cadena, 1) <> 0, "", Replace(cadena, " ", sep)) & "     | n = " & n
    Else 'on ne veut récupérer que les Nº de postes fixes
        ExtractTelPortable = IIf(Left(cadena, 1) = 0, "", Replace(cadena, " ", sep)) & "     | n = " & n
    End If
End Function
Ça a l'air d'enfin bien marcher. Il demeure néanmoins un problème au niveau de la boucle.
Sur la PJ, c'est je pense assez clair.
 

Pièces jointes

  • Pattern Forum (5+++).xlsm
    30.3 KB · Affichages: 37

Magic_Doctor

XLDnaute Barbatruc
Re,

Pas vraiment compris. Quel rapport avec ce fil et mon dernier post ?

Mais, rétrospectivement, tout le monde m'a en fait aidé pour cette fonction : job, toi, Pythagore, l'amère Denis et tous les autres... Sans oublier mon instit de 9ème !
Quoi qu'il en soit, cette fonction est de mon cru...
 

Staple1600

XLDnaute Barbatruc
Re

Le rapport, c'est ce bout de code
*************** Épurage de la chaîne initiale ***************
MesBoSep = Array(".", ",", ";", "-", "/", "|", "~", "*", "+")
For Each a In MesBoSep
maChaine = Replace(maChaine, a, " ")
Next

Que je t'ai fourni aujourd'hui non ?
Bonsoir le fil, le forum

@Magic_Doctor
Voir du côté de RegExp et de ses patterns
(sauf pour les macistes ;))
ou aussi de du côté de la boucle
VB:
Sub Macro1()
Dim MesBoSep, maChaine As String
maChaine = "12;345~~6M.,a-g/ic|Do|tor"
MesBoSep = Array(".", ",", ";", "-", "/", "|", "~")
For Each a In MesBoSep
maChaine = Replace(maChaine, a, "")
Next a
MsgBox maChaine
End Sub


NB: Maintenant tu as des problèmes de mémoire immédiate (lol)
 

Magic_Doctor

XLDnaute Barbatruc
Là il s'agit, dans cette fonction, d'un détail superfétatoire. Que cette mise en forme de la chaîne y soit ou pas, c'est strictement pareil quand on part du principe qu'à l'origine la chaîne a bien été "tapée" !
C'est uniquement pour le fun. Mais pour comprendre, encore faut-il ouvrir la PJ.
Allez Staple ! Un peu le sens de l'humour. La vie est courte tu sais !
Mais si tu veux que l'on te cite à chaque occasion, pas de problème.

PS : tu auras peut-être remarqué que dans les macros et autres UDF qui accompagnent mes PJ, je cite TOUJOURS les auteurs (parfois je m'y inclus, narcissisme oblige !). Vérifie !
Mais de là à citer tout le monde depuis le début...
On résumera ainsi : ¡GRACIAS AL FORUM DE EXCEL DOWNLOADS!
Et comme ça tout le monde il est content !
 
Dernière édition:

Staple1600

XLDnaute Barbatruc
Re

Pour ce faire, j'ai repris la procédure de BOISGONTIER et l'ai modifiée, comme j'ai pu.
Si c'est là, ta pratique usuelle, il manquait donc dans ton message par exemple, un truc du genre
"Pour ce faire, j'ai repris la procédure de Staple et l'ai modifiée, comme j'ai pu."

Voilà, donc j'ai vérifié pour le fun ;)

NB: Ce qui m'intriguait c'est que tu ne cites que certains d'entre nous.
Tu dois avoir tes préférences.
 

Magic_Doctor

XLDnaute Barbatruc
Staple, je vous ai compris !
VB:
Function ExtractTelPortable(maChaine As String, x As Byte, sep As String, Optional tel As Boolean = True) As String
'Supprime dans une chaîne certains caractères
'Staple1600 Soló

Dim MesBoSep, a, n As Byte

    '*************** Épurage de la chaîne initiale ***************
    MesBoSep = Array(".", ",", ";", "-", "/", "|", "~", "*", "+")
    For Each a In MesBoSep
        maChaine = Replace(maChaine, a, " ")
    Next
    '*************************************************************
    ExtractTelPortable = maChaine 
End Function
Je n'ai aucun problème avec ta fonction.
Mai j'en ai avec la mienne :
VB:
Function ExtractTelPortable(maChaine As String, x As Byte, sep As String, Optional tel As Boolean = True) As String
'Extraie des séries de Nº d'une chaîne
'Magic_Doctor
'- maChaine : la chaîne contenant des séries de Nº
'- x : position du Nº que l'on recherche dans la chaîne
'- sep : séparateur que l'on veut placer entre les groupes de chiffres d'un même Nº
'- tel : par défaut "True" (--> portables). Si "False", alors il s'agit de Nº de postes fixes

'J'ai privilégié les portables, car je pense que les postes fixes sont voués à disparaître... It's good for Big Brother!
'Et pour bien nous casser les couilles quand on arrive en France et que l'on ne peut prévenir personne à la Gare du Nord où il n'y a plus une seule cabine téléphonique...!!!

Dim n As Byte, i As Integer, j As Integer, trouve As String, cadena As String

'En supposant que "maChaine" ait été bien écrite, à savoir :
'- groupes de chiffres séparés uniquement par un seul espace
'- Nº (ensembles de groupes de chiffres) séparés par n'importe quoi sauf un espace
  
    For n = 1 To x
        For i = 1 To Len(maChaine)
            trouve = Mid(maChaine, i, 1)
            If IsNumeric(trouve) Then
                maChaine = Right(maChaine, Len(maChaine) - i + 1) 'on supprime tout ce qui n'est pas numérique à gauche de la chaîne
                For j = 1 To Len(maChaine)
                    trouve = Mid(maChaine, j, 1)
                    If trouve <> " " And IsNumeric(trouve) = False Then
                        cadena = Trim(Left(maChaine, j - 1)) 'on récupère uniquement la 1ère série de chiffres (à gauche) de "maChaine" : celle qui nous intéresse
                        maChaine = Mid(maChaine, Len(cadena) + 1, Len(maChaine) - Len(cadena)) '"maChaine" est amputée de sa 1ère série de chiffres
                        Exit For
                    End If
                Next
                Exit For
            End If
        Next
    Next
  
    If sep = "Nada" Then sep = "" 'facultatif. Ici, uniquement pour les besoins de la liste déroulante de la feuille où "Nada" = rien du tout
  
    If tel Then 'on ne veut récupérer que les Nº de portables
        ExtractTelPortable = IIf(Left(cadena, 1) <> 0, "", Replace(cadena, " ", sep)) & "     | n = " & n
    Else 'on ne veut récupérer que les Nº de postes fixes
        ExtractTelPortable = IIf(Left(cadena, 1) = 0, "", Replace(cadena, " ", sep)) & "     | n = " & n
    End If
End Function
 
Dernière édition:

Staple1600

XLDnaute Barbatruc
Re

Comme dit dans l'autre message, c'est un problème typique qui fleure bon les expressions régulières: à savoir RegExp
Il suffit donc de trouver le bon pattern.

Un exemple retrouvé dans mes archives en guise d'illustration
VB:
Sub Macro_RegExp()
Dim str$, n&, i&, cmat As Object, ws As Worksheet
Set ws = ActiveSheet
'générer données de test
ws.Cells.Clear
ws.Range("A1").FormulaR1C1 = _
        "=""toto""&ROW()&CHAR(10)&""toto1@domain.com""&""123-456-""&TEXT(ROW(),""0000"")&CHAR(10)&""1 rue des 1001 35000 RENNES""&CHAR(10)&""525-965-""&TEXT(ROW(),""0000"")"
ws.Range("A1").AutoFill Destination:=Range("A1:A100"), Type:=xlFillDefault
'extration numéro de tel
With CreateObject("VBScript.RegExp")
    .Global = True
    .MultiLine = True
    'Numéro de tel avec ce format : ###-###-####
    .Pattern = "[0-9,\-]{12}"
        For i = 2 To ws.Cells(Rows.Count, "A").End(xlUp).Row
        str = ws.Cells(i, "A").Value2
            If .Test(str) Then
            Set cmat = .Execute(str)
            For n = 0 To cmat.Count - 1
            ws.Cells(i, Columns.Count).End(xlToLeft).Offset(0, 1) = cmat.Item(n)
            Next n
            End If
        Next i
End With
ws.Range("A1:A100").WrapText = True
End Sub
 
Dernière édition:

Magic_Doctor

XLDnaute Barbatruc
Re,

J'ai laissé tomber en ce moment les "Patterns".
Ce que je voudrais comprendre, c'est pourquoi ce problème avec la fonction précédente qui, une fois le problème réglé (si tant est que ce soit possible de le régler...), marchera très bien, quel que soit le cas de figure.
 
Dernière édition:

Staple1600

XLDnaute Barbatruc

Magic_Doctor

XLDnaute Barbatruc
Bonjour,

Dommage que personne n'ait pu m'expliquer le pourquoi du comment la boucle de ma fonction ne marchait pas parfaitement. Même si finalement ce n'est pas bien grave, ça me turlupine quand même.
Bref, plutôt que de tourner en rond, je pose la question sur un autre forum (loin, très loin pour les traqueurs de ceux qui osent poser la même question sur plusieurs forums...). Là, on ne me donne toujours pas d'explication au sujet de ce qui cloche dans ma fonction ; en revanche on me propose une solution, mais via les expressions rationnelles ("Patterns"), auxquelles j'avais fini par renoncer. J'avoue n'avoir pas très bien compris la syntaxe du "Pattern", mais enfin ça marche du tonnerre ! Et c'est court !!
VB:
Function ExtractTelPortable(maChaine As String, pos As Long, sep As String, Optional tel As Boolean = True) As String
'Extraie des Nº (séries de chiffres regroupés) d'une chaîne
'pgc01
'- maChaine : la chaîne contenant des séries de Nº
'- pos : position du Nº que l'on recherche dans la chaîne
'- sep : séparateur que l'on veut placer entre les groupes de chiffres d'un même Nº
'- tel : par défaut "True" --> portables. Si "False" --> postes fixes

Dim s As String

On Error GoTo Exit_Function
With CreateObject("VBScript.RegExp")
    .Pattern = "\b\d(\d| )*\b"
    .Global = True
    s = .Execute(maChaine)(pos - 1)
End With

ExtractTelPortable = Replace(IIf(tel Xor (Not s Like "0*"), s, ""), " ", sep)
Exit_Function:
End Function
 

Staple1600

XLDnaute Barbatruc

Magic_Doctor

XLDnaute Barbatruc
Staple, freine ton égo.
Tout le monde a le nez fin.
Depuis le post #9 où je relance le fil en y rajoutant certaines conditions, je précise bien que je tente d'y parvenir au moyen de la procédure de BOISGONTIER, autrement dit des "Patterns".
J'étais arrivé à quelque chose, mais de fort tordu. Normal, quand on n'est pas habitué à ce langage.
Je me résigne en essayant de résoudre le problème par un autre moyen, et là j'y suis presque arrivé (cf. ma fonction qui marche presque).
Qu'on se parachute sur un fil, je veux bien, mais encore faut-il survoler l'épistémologie du fil. Et là tu aurais compris que depuis le fil de BOISGONTIER, tout le monde a le nez fin !

Tiens, pour te faire plaisir :

VB:
Function ExtractTelPortable(maChaine As String, pos As Long, sep As String, Optional tel As Boolean = True) As String
'Extraie des Nº (séries de chiffres regroupés) d'une chaîne
'Staple1600
'- maChaine : la chaîne contenant des séries de Nº
'- pos : position du Nº que l'on recherche dans la chaîne
'- sep : séparateur que l'on veut placer entre les groupes de chiffres d'un même Nº
'- tel : par défaut "True" --> portables. Si "False" --> postes fixes

Dim s As String

On Error GoTo Exit_Function
With CreateObject("VBScript.RegExp")
    .Pattern = "\b\d(\d| )*\b"
    .Global = True
    s = .Execute(maChaine)(pos - 1)
End With

ExtractTelPortable = Replace(IIf(tel Xor (Not s Like "0*"), s, ""), " ", sep)
Exit_Function:
End Function
Et pour aller fouiner où j'ai bien pu poser la question... Tu as vraiment du temps à perdre !
Parfois on se sent cerné...
 

Staple1600

XLDnaute Barbatruc
Re

@Magic_Doctor
Si je devais freiner au niveau ego, tu devrais accélérer au niveau humour et dérision.
Je n'ai rien dit autre que ta question était une question typique RegExp
simplement pour que tu ré-envisages cette piste que tu avais mis de côté.
Et j'ai juste évoqué mes narines, pas mon ego.
(Le tout sur ton de l'humour: d'où l'émoticone et les jeux de mots dans mon message précédent...)

NB: Que vient faire ici l'épistémologie?

PS:Je n'ai pas besoin de fouiner
Je suis également membre du forum mrexcel
(comme d'une grande part des forums anglophones)
 

Discussions similaires

Statistiques des forums

Discussions
311 720
Messages
2 081 926
Membres
101 842
dernier inscrit
seb0390