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

[MERLIN]

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.

 

[Chefredo]

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

une petite formule à recopier dans la colonne concernée

attention : la formule récupère les 14 caractères à partir du 1er zéro trouvé. donc :
- s'il y a un autre 0 avant dans la cellule, le résultat sera faux
- s'il y a plusieurs téléphones dans la cellule, seul le 1er sera renvoyé dans le résultat

mais dans ton exemple : ça marche.

chefredo

 

[david84]

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

Bonsoir,
l'utilisation d'une expression rationnelle ou de l'opérateur Like te permettent de traiter ton problème.
Vois cet exemple ou celui-là sur le site de JB.
Les explications se trouvent ici (et à la suite pour le RegExp).
A+

 

[MERLIN]

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

Merci à tous ! je vais tester cela !!!!!!

 

[mapomme]

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

Bonsoir Merlin,

Un autre code VBA qui fonctionne pour les numéros avec ou sans séparateur et qui commencent par un 0.

 

[BOISGONTIER]

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

Bonsoir,

Il peut y avoir plusieurs nos

Function Tph(chaine, n)
  Set obj = CreateObject("vbscript.regexp")
  obj.Global = True
  obj.Pattern = "\d{2}[-/. ]*\d{2}[-/. ]*\d{2}[-/. ]*\d{2}[-/. ]*\d{2}"
  Set a = obj.Execute(chaine)
  If a.Count > n - 1 Then Tph = a(n - 1) Else Tph = ""
End Function

JB

 

[mapomme]

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

Bonsoir Merlin,

Une fonction personnalisée VBA compatible avec plusieurs numéros (mais bien moins élégante que celle de BOISGONTIER)
Edit: v4 conserve l'ordre des numéros.

Public Function NiemeTEL(Cellule As Range, Optional Nieme As Byte = 0)
'Si Nieme <= 0 ou manquant alors retourne le nombre de numéros de tél trouvés
Dim i, j, S, trouve, Tel(), N
    For j = 1 To Len(Cellule) - 9
        S = Mid(Cellule, j, 14)
        If S Like "0#?##?##?##?##" Then
            S = Replace(S, Mid(S, 3, 1), ".")
            N = N + 1
            ReDim Preserve Tel(1 To N)
            Tel(N) = S
            j = j + 13
        End If
        S = Mid(Cellule, j, 10)
        If S Like "0#########" Then
            S = Mid(S, 1, 2) & "." & Mid(S, 3, 2) & "." & Mid(S, 5, 2) & "." & Mid(S, 7, 2) & "." & Mid(S, 9, 2)
            N = N + 1
            ReDim Preserve Tel(1 To N)
            Tel(N) = S
            j = j + 9
        End If
    Next j

If Nieme = 0 Then
    NiemeTEL = N
ElseIf Nieme > N Then
    NiemeTEL = ""
Else
    NiemeTEL = Tel(Nieme)
End If

End Function

 

[JBOBO]

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

Bonjour,

En B2 :

=SI(A2="";"";SUBSTITUE(STXT(A2;SI(ESTERREUR(CHERCHE("06????????????";A2));CHERCHE("07????????????";A2);CHERCHE("06????????????";A2));14);CAR(CODE(STXT(A2;SI(ESTERREUR(CHERCHE("06????????????";A2));CHERCHE("07????????????";A2);CHERCHE("06????????????";A2))+2;1)));$B$1))

, avec en B1, le caractère separateur (le point, un espace, un tiret ou autre.)

Permet de gerer les 06 et les 07. on peut aussi completer en C2 :

=SI(ESTNUM(CNUM(SUBSTITUE(B2;$B$1;"")));B2;"")

pour n'avoir d'afficher que des chiffres. (Pas réussi à ne faire qu'une seule formule, trop de niveaux d'imbrications me dit excel).

 

[Magic_Doctor]

Bonsoir,

Je cherchais quelque chose au sujet des chaînes et je tombe sur ce fil.
La réponse de BOISGONTIER m'a bien plu, concise et efficace comme à son habitude.
En première lecture : tout à fait absconse. Je n'avais jamais vu ce type de syntaxe. Donc je m'y intéresse en cherchant sur le net et découvre ainsi le monde des "expressions rationnelles".
Je commence enfin à mieux saisir la routine de BOISGONTIER, même si certains points demeurent totalement obscurs.
Le but de l'opération est donc d'extraire des numéros de téléphone éparpillés dans une chaîne de caractères.
En France on a généralement pour habitude de regrouper les chiffres d'un numéro de téléphone par 2 : 06 98 55 63 17
Mais il peut arriver, pour des raisons purement mnémotechniques, de les regrouper par 2 et 3 : 06 50 03 00 12 ---> 06 500 300 12
Et, toujours, quand on donne un Nº de portable, on commence par 06.
Ce n'est pas le cas partout. En Uruguay, par exemple, les Nº de portable ne comportent que 9 chiffres (10 en France), et le préfixe est toujours de 3 chiffres (099, 094...).
Mon idée a été de tenter d'extraire d'une chaîne des Nº de téléphones portables, qu'ils soient français ou uruguayens et quelle que soit la manière dont on a regroupé les chiffres : 06 66 99 55 76 | 094 54 20 44 | 099 925 301 | 06 300 200 11 ...
Pour ce faire, j'ai repris la procédure de BOISGONTIER et l'ai modifiée, comme j'ai pu.
Le résultat est quand même pas mal, mais pas encore parfait. Je ne suis pas encore arrivé à obtenir une fonction générale qui résolve le problème, à savoir : j'ai tous ces numéros éparpillés dans une chaîne, je stipule le rang d'un des numéros et la fonction me renvoie le numéro correspondant, uniquement s'il s'agit d'un numéro de portable.
Je ne sais pas si ça peut vraiment servir à quelque chose dans la réalité, mais le "défi" m'a amusé.
Tout est normalement explicite dans la PJ.

Des amateurs pour m'aider à arriver jusqu'au bout, tout en restant dans le même esprit que BOISGONTIER ?

 

[Magic_Doctor]

Bonsoir,

Je reviens sur ce fil qui passionne les foules, après quelques modifications mineures.

 

[laurent950]

Bonsoir le forum,

J'ai trouvé une solution Top

Sub tt()
    Dim sht As Worksheet
    Set sht = Worksheets("Feuil1")
    Dim r As Range
    ' Nettoyage
    sht.Range(sht.Cells(2, 2), sht.Cells(sht.Cells(65536, 1).End(xlUp).Row, 2)).Select
    For ligne = 2 To sht.Cells(65536, 1).End(xlUp).Row
        Set r = sht.Cells(ligne, 1)
            resultat = NumTelGB(r)
            sht.Cells(ligne, i + 2) = resultat
            resultat = Empty
            Set r = Nothing
    Next ligne
End Sub
Function NumTelGB(col As Range) As String
    ' Numéro 10 chiffres
        Dim TabDix() As Variant
        J = 0
        ReDim TabDix(J)
    ' Numéro supérieur ou Inférieur à 10 chiffres
        Dim Tabautres() As Variant
    ' vidé la variable
        NumTelGB = Empty
    ' Boucle sur le nombre de caractére.
    For i = 1 To Len(col)
        a = Mid(col, i, 1)
        If a = " " Then

        ElseIf a = "." Then

        ElseIf a = "/" Then

        ElseIf a = "\" Then

        ElseIf IsNumeric(a) Then
            TabDix(J) = a
            J = J + 1
            ReDim Preserve TabDix(J)
        End If
   Next i

If UBound(TabDix) = 10 Then
        For J = LBound(TabDix) To UBound(TabDix) - 1
            TabDix(UBound(TabDix)) = TabDix(UBound(TabDix)) + TabDix(J)
        Next J
            For J = 1 To Len(TabDix(UBound(TabDix))) Step 2
                a = Mid(TabDix(UBound(TabDix)), J, 2)
                x = x + a & "."
            Next J
    numero = Mid(x, 1, 14)
    NumTelGB = numero
Else
        For J = LBound(TabDix) To UBound(TabDix) - 1
            TabDix(UBound(TabDix)) = TabDix(UBound(TabDix)) + TabDix(J)
        Next J
            For J = 1 To Len(TabDix(UBound(TabDix))) Step 2
                a = Mid(TabDix(UBound(TabDix)), J, 2)
                x = x + a & "."
                n = n + 1
            Next J
    numero = Mid(x, 1, UBound(TabDix) + n - 1)
    NumTelGB = numero & " : Incomplet ! Ou International !"
End If
End Function

Détecter si les Numéros sont à 10 Chiffres puis formatage du numéro.
Condition si inférieur ou supérieur à 10 chiffres donc (Incomplet ou International) = detceté.

La base est propre c'est efficace.

Le top serais de faire un module de classe... Il faudrait beaucoup de combinaisons de numéros de téléphones.

au plaisir de partager avec vous d'autres astuces

laurent

 

[laurent950]

Bonsoir Magic,
Cela pêche à cette endroit.

A Partir d'ici c'est un simple hazar !
cela veux dire que ca ne fonctionne pas ! ou peux donner un résultat étonné
suit a l'explication plus bas !

c'est extrait de votre code.

    Set a = reg.Execute(Chaine) 'KÉZAKO ?
        If a.Count > n - 1 Then 'KÉZAKO ? C'est des positions donc n-1 sert a rien
        MsgBox a(0)
            b = prefixe.Test(a(n - 1)) 'vérifie si le 1er chiffre du Nº de téléphone est bien "0" (donc portable)
            ExtractTelPort = IIf(b = False, "", IIf(Nb_Num(a(n - 1)) < 9, "", SingleSpaceBetweenWords(a(n - 1)))) 'condition Nb_Num(a(n - 1)) < 9 : bien obligé de tricher un peu...
        Else
            ExtractTelPort = ""
        End If

Le résultat est en fait édité dans une variable qui crées des ITEM (avec a )
la positon ne correspond pas a la chaîne demandé par la fonction

Pour le résultat 1 = il y a (1 Item)
Item correspond à 0 et (n à 1) donc (n-1 = 0) est le numéro est bien trouvé
Pour le résultat 2 = il y a (3 Item)
Item correspond à 1 est (n à 2) donc (n-1 = 1) est le numéro est bien trouvé
Pour le résultat 3 = il y a (1 Item)
Item correspond à 0 est n à 3 donc (n-1 = 2) est le numéro est pas trouvé (Normal il y a 1 Item et Item 2 existe pas)

Je veux bien y réfléchir c'est intéressante avec des éléments de mon autres code ont peux arriver à faire quelque choses mais il faut comprendre un mécanisme complexe.

de plus :
Set reg = CreateObject("vbscript.regexp") 'j'imagine qu'on créé une espèce de répertoire

la Classe des RegExp (Ont crée un Objet à Partir d'une classe existante) c'est du modèle Objet donc pas facile a déchiffrer

Laurent

 

[laurent950]

Pour Faire suite,
Pour que cela fonctionne il faut Modifier cette partie de votre code :

    Select Case chx
        Case 1
            strPattern = "\d{2}\s" '2 chiffres & espace(s)
            reg.Pattern = Application.WorksheetFunction.Rept(strPattern & "*", 5) 'Nº de 10 chiffres
regroupés par 2 : 5 "blocs" de chiffres (a.Count = 1)
Crée autant d'item que de groupe de numéro à 5 groupes (x 2 chiffres séparer d'un espace)
soit = 1 numéro de téléphone trouvé = 1 Item
        Case 2
            strPattern = "\d{2,3}\s" '2 ou 3 chiffres & espace(s)
            reg.Pattern = Application.WorksheetFunction.Rept(strPattern & "*", 4) 'Nº de 9 ou 10 chiffres regroupés par 2 et par 3 : 4 "blocs" de chiffres (a.Count = 3)
Crée autant d'item que de groupe de numéro à 5 groupes de  (4 x 2 chiffres séparer d'un espace)
soit = 3 numéros de téléphones trouvé = 3 Item
        Case 3
            strPattern = "\d{3}\s" '3 chiffres & espace(s)
            reg.Pattern = Application.WorksheetFunction.Rept(strPattern & "*", 3) 'Nº de 9 chiffres TOUS regroupés par 3 : 3 "blocs" de chiffres (a.Count = 1)
Crée autant d'item que de groupe de numéro à 3 groupes (x 3 chiffres séparer d'un espace)
soit = 1 numéro de téléphone trouvé = 1 Item
    End Select

Le soucis c'est que la position n dans la phrase (c'est la dire par exemple le 7 éme numéro de téléphone a extraire ne correspondra jamais avec le numéro de téléphone générer dans les Items (Moi j'appelle cela des tableaux "Item commence à 0)

Avec le numéro de téléphone trouvé avec cette motif : 999 301 220

Laurent

 

[Magic_Doctor]

Bonsoir laurent950,

Je vais reprendre ce sujet (j'ai laissé décanter...). En effet, ce n'est pas simple et à mon niveau encore moins. Mais le problème, comme vous le soulignez, est néanmoins intéressant (même si la finalité n'est que pour le fun) : une fonction qui extrairait d'une chaîne tous les numéros de portables (ou pas selon paramétrage) et ce quels que soient les regroupements des chiffres.

 

[laurent950]

J'ai la solution je dois faire la procédure, poste 13 explique des choses

ont reprend plus tard

Bonne soirée merci