Isoler un n° de tél dans une chaîne de txt

[Magoo]

Re bonsoir à tous,

Si qqu'un à une actuce pour isoler un n° de tél dans une chaîne de texte en VBA.
Merci g + de 2000 textes à traiter rapidement et je bloque avec ce téléphone :sick:

Ex de texte :'avenue des Fils Foucquaud / Tel : 05 48 29 86 31 Fondée au début du 12e siècle, '

Ou :'pas de transport en commun Téléphone 02 52 80 75 41 commanderie'

Merci
Bonne nuit

Magoo

 

[myDearFriend!]

Bonsoir Magoo,


Après avoir sélectionné une cellule contenant le texte, tu peux essayer cette procédure :

Sub IsoleNumTel()
Dim Chaine As String
    Chaine = Selection.Value
    If Chaine Like '*## ## ## ## ##*' Then
        Do
            Chaine = Mid(Chaine, 2)
        Loop Until Chaine Like '## ## ## ## ##*'
        Chaine = Left(Chaine, 14)
        MsgBox Chaine
    End If
End Sub

Cordialement

 

[Magoo]

Bonjours myDearFriend! et le forum,

Je suis étonné de ne pas voir ici mon message de remerciement. En effet 3 heures après avoir déposé ma question, je suis revenu pour indiqué que j'avais réussi à bidoullier une solution quand j'ai découvert ta réponse (je n'avais pas actualisé IE) ). Et bien sûr ton code était bien plus optimisé que le mien. :unsure: donc de nouveau merci.

Je reviens avec 3 questions :

1 - compréhension. A quoi correspond la valeur 2 dans
Chaîne = Mid(Chaîne, 2) (je comprends la fonction)

2 - adaptation. Dans mes textes il peut y avoir plusieurs numéros et des fois répéter. Comment les récupérer sans les doublons. J'ai une variable Téléphone(n).

3 - adaptation. Peut on adapter ce code pour rechercher des emails ou des adresses web?

Merci à toi et au forum
Magoo
Ps : J'ai vu ton Calendrier mDF 3.0 il est super !

 

[myDearFriend!]

Bonsoir Magoo, le Forum.

A quoi correspond la valeur 2 dans
Chaîne = Mid(Chaîne, 2) (je comprends la fonction)

Prenons un exemple :
Si Chaine = 'ABCDEFG' alors Mid(Chaîne, 2) = 'BCDEFG'
Ca permet tout simplement de supprimer le premier caractère de la chaîne en 'récupérant' uniquement les caractères à partir du deuxième (donc 2).

Dans mes textes il peut y avoir plusieurs numéros et des fois répéter. Comment les
récupérer sans les doublons. J'ai une variable Téléphone(n).

Si dessous, peut-être une solution à adapter :

Sub RecupTelSansDoublon()
Dim T() As String
Dim Telephone As New Collection
Dim i As Integer
'Récupération des num.téléphoniques dans une variable tableau T(n)
' ....... (voir code de récupération dans post précédent)
'
'Affectation des numéros dans une collection Telephone() en éliminant les doublons
On Error Resume Next
For i = 1 To UBound(T, 1)
Telephone.Add T(i), CStr(T(i))
Next i
On Error GoTo 0
'Affichage des numéros (sans doublon) sur la feuille 1
For i = 1 To Telephone.Count
Sheets(1).Cells(i, 1).Value = Telephone(i)
Next i
End Sub

Peut on adapter ce code pour rechercher des emails ou des adresses web?

Ces deux types d'expression sont des chaines de caractères dont les caractéristiques particulières peuvent sans doute les rendre détectables au milieu d'un texte. Je pense notamment à :

- Email : contient le caractère '@' et ne comporte pas d'espace.
- Adresse Web : commence par 'http:' et ne comporte pas d'espace.

Je n'ai pas vraiment creuser la question, mais je pense qu'il conviendrait d'isoler chaque expression (mot) dans le texte pour en tester son contenu et ainsi déterminer s'il peut s'agir d'un Email ou d'une adresse Web potentielle...

Pour récupérer tous les mots ou expressions du texte afin de les tester, tu pourrais faire quelque chose comme ça :

Sub TestExpression()
Dim Chaine As String
Dim Mots As Variant
Dim i As Long
Chaine = LeTEXTE
'Isole chaque mot du texte et les mémorise dans un tableau variant
Mots = Split(Chaine, ' ', -1, 2)
'Affiche chaque mot dans la colonne A de la feuille 1
For i = 1 To UBound(Mot, 1)
Sheets(1).Cells(i, 1).Value = Mots(i)
Next i
End Sub

J'espère que ces réponses pourront te venir en aide...

Et merci pour le compliment...

Cordialement.

Message édité par: myDearFriend!, à: 02/03/2005 23:32

 

[Magoo]

Super myDearFriend!
Je regarde et tient au courrant
Magoo

 

[Magoo]

Rebonsoir,

Merci de ta réponse très pédagogique, cela ma permis d'enrichir mon vocabulaire VBA et me remet la patate pour coder cette nuit.
Je vais intégré le trois.
Sinon je viens de tester le point 2 la recherche de plusieurs numéros, mais je ne sais pas comment faire bouclés le premier code pour qu'il trouve le second numéro, le troisième ... pour les enregistrer dans la variable tableau.

Sub RecupTelSansDoublon()
Dim T() As String
Dim Telephone As New Collection
Dim i As Integer
Dim Chaine As String
'Récupération des num.téléphoniques dans une variable tableau T(n)
' ....... (voir code de récupération dans post précédent)
    Chaine = Selection.Value
    If Chaine Like '*## ## ## ## ##*' Then
        Do
            Chaine = Mid(Chaine, 2)
        Loop Until Chaine Like '## ## ## ## ##*'
        Chaine = Left(Chaine, 14)
        MsgBox Chaine
    End If

'Affectation des numéros dans une collection Telephone() en éliminant les doublons
On Error Resume Next
For i = 1 To UBound(T, 1)
Telephone.Add T(i), CStr(T(i))
Next i
On Error GoTo 0
'Affichage des numéros (sans doublon) sur la feuille 1
For i = 1 To Telephone.Count
Sheets(1).Cells(i, 1).Value = Telephone(i)
Next i
End Sub

Merci beaucoup à toi et bonne nuit à tous

 

[myDearFriend!]

Re- Magoo,


Pour que je puisse t'aider d'avantage, j'ai besoin d'en savoir d'avantage...

Quand tu dis 'g + de 2000 textes à traiter rapidement' :
- Comment se présentent ces textes ?
- S'agit t'il de 'phrases' placées dans les cellules d'une feuille ?
- Si oui, en colonne, en ligne ?
- Peut-il y avoir plus d'un numéro de téléphone dans la même 'phrase' ?

 

[Magoo]

Re-myDearFriend!

Quand tu dis 'g + de 2000 textes à traiter rapidement' :
J'ai pris du retard c 5000 textes maintenant
- Comment se présentent ces textes ?
Complètement en vrac.
- S'agit t'il de 'phrases' placées dans les cellules d'une feuille ?
Oui pour tout me simplifier.
- Si oui, en colonne, en ligne ?
le + souvant réparti sur 2 à 4 colonnes et une 50n de ligne.
- Peut-il y avoir plus d'un numéro de téléphone dans la même 'phrase' ?
Oui c le souçi

De ces textes, j'en isole une 30n d'éléments, j'arrive à la fin, mais je ne bouge pas de mon écran depuis 10 jours.
J'ai fait un module qui récupère les numéros de téléphone dans une variable tableau. Il est un peu empirique, voici un échatillons

    For CompteurCar = 1 To NombDeCar
        f = Mid(Chaine, CompteurCar, 1)
        If f = 0 Then
            f = Mid(Chaine, CompteurCar + 1, 1)
            If f >= 0 And f < 10 Then
                f = Mid(Chaine, CompteurCar + 2, 1)
                If f = ' ' Then
                    f = Mid(Chaine, CompteurCar + 3, 1)
                    If f >= 0 And f < 10 Then
                        f = Mid(Chaine, CompteurCar + 4, 1)
                        If f >= 0 And f < 10 Then
                            f = Mid(Chaine, CompteurCar + 5, 1)
                            If f = ' ' Then
                                f = Mid(Chaine, CompteurCar + 6, 1)

                               f = Mid(Chaine, CompteurCar + 14, 1)
                               If f = ' ' Then
                                     u(h) = Mid(Chaine, CompteurCar, 14)
                                     h = h + 1
                                Else
                                End If
                          End If

la gestion des doublons me posé problème. Mais j'intègre ta solution qui si je l'ai bien compris gère le doublon comme étant une erreur?
Dans On Error GoTo 0 0 correspond à quoi ? j'ai rien trouvé

Merci beaucoup de ton aide

 

[Magoo]

Désolé le code est en vrac ! dans Aperçu c'était bon
c'est toujours pas top mais plus lisible

For CompteurCar = 1 To NombDeCar
f = Mid(Chaine, CompteurCar, 1)
If f = 0 Then
f = Mid(Chaine, CompteurCar + 1, 1)
If f >= 0 And f < 10 Then
f = Mid(Chaine, CompteurCar + 2, 1)
If f = ' ' Then
f = Mid(Chaine, CompteurCar + 3, 1)


f = Mid(Chaine, CompteurCar + 14, 1)
If f = ' ' Then
u(h) = Mid(Chaine, CompteurCar, 14)
h = h + 1
Else
End If
End If

Magoo

 

[myDearFriend!]

Tes réponses à mes questions, concernant notamment la distribution des 'textes' dans la feuille ne m'aide pas vraiment...

Il commence à se faire tard et je reprendrai demain soir ce fil si je peux te proposer une solution 'globale' à ton problème.

Concernant la méthode pour éliminer les doublons, dès lors o&ugrave; tu as obtenu ta variable tableau contenant les différents numéros de téléphone, tu as déjà fait le plus dur !

Pour éliminer les doublons, j'ai utilisé là une astuce de J.G. Hussey.
Cette astuce consiste à charger les éléments dans un objet collection par la méthode Add et l'utilisation d'une clé unique :

LaCollection.Add Elément, Clé unique

En reprenant, le code que j'ai utilisé plus haut :
Dans la boucle, tu ajoutes donc chaque élément dans la collection accompagné d'une clé (valeur String) qui ne peut être qu'unique. En guise de clé, tu utilises à nouveau la valeur de l'élément en t'assurant qu'il s'agit bien d'une valeur String, c'est à dire chaine de caractères (d'o&ugrave; l'utilisation du CStr() cette fois).

S'il n'est pas déjà présent, l'élément est donc ajouté dans la collection.

Par contre, si cet élément (et sa clé) existe déjà dans la collection, cela provoque une erreur. Mais comme tu as précédé cette boucle d'une gestion d'erreur 'On error resume next', la procédure ne s'arrête pas, mais passe à l'instruction suivante sans prendre en compte l'élément doublon !

Et la boucle se poursuit ainsi jusqu'à la fin et tu n'obtiens en résultat, qu'une collection de valeurs uniques.

Le 'On error Goto 0' c'est simplement l'instruction qui permet d'annuler le gestionnaire d'erreur.


@+

 

[Magoo]

Merci de ces explications, c très clair.

Concernant la distribution des textes dans la feuille, mon cahier des charges est que mon programme doit pouvoir fonctionner avec n'importe quel texte.
La source des textes que l'on me fourni est très disparate :
- Des fiches clients papiers manuscrite ou en partie dactylographié que je récupère à la chaine en OCR.
- Des annuaires professionels ou la mise en page est complètement déscruturé par les messages publicitaires.
- Des éléments que je récupère sur leur Intranet
- ...
et par exemple pour les téléphones noyés dans le texte il peut être écrit :
01 40 20 30 17
0140203017
33(1) 40 20 30 17
...
Je dois récupérer et structurer toute ces infos dans une base de donnée unique. Mon programme actuel récupère 88% des infos, chaques améliorations à un impact important en temps pour la personne qui devra compléter les éléments manquants.
Et ton aide m'a permis de gagner du temps avec notamment des fonctions que je ne connaissais pas.
If Chaine Like '*## ## ## ## ##*' Then
Je dois avoir bouclé pour ce soir.
Merci encore
Magoo
Je débute en VBA mais j'y prends go&ucirc;t