Import d'adresse depuis doc TXT

Bonjour,

je souhaite construire un listing d'adresse mail depuis un doc TXT qui comporte ce type d'info :

CA
65, avenue 
BP 37
94230 - 000 - France
TEL :00 00 00 00 00
FAX :00
WEB : http://www.000.com
EMAIL : contact@000.com

D
60, route 
89380 - ville - France
TEL :00 00 00 00
WEB : http://www.000.com

D CA
Rue G
17640 - ville- France
TEL :00 00 00 00
WEB : http://www.000n.com
EMAIL :

Chaque adresse mail commence toujours par l'intitulé "EMAIL" url du site par "WEb" et la première ligne le nom de la société.

Comment puis-je importer dans excel la liste complète présent dans le doc txt et ainsi construire un listing comme cela :

"Nom", "EMAIL", "WEB".

Pour information le doc en question comporte plus de 4000 adresses, donc impossible de le faire a la mains.

Merci de votre aide !

un début de nettoyage

(grâce aux colonnes de pointage)

sauras-tu "faire remonter" les infos sur une même ligne ?

Je ne sais pas si je vais reussir je regarde de suite

-- 17 Juin 2010, 14:32 --

je ne comprend pas trop comment faire !?

voilà

reste à :

• copier/collagespécial valeurs (pour ne pas conserver les formules)
• effacer les lignes pour lesquelles la cellule de la colonne B est vide

attention : tes zones d'adresses et mail d'origine ne doivent pas faire moins de x lignes ni plus de y lignes

(avant d'effacer les lignes de B vides regarde bien tout)

et les espacements entre les blocs d'origine doivent faire 2 lignes au moins

c'est un peu du bricolage, mais ça reste facile à faire et à reproduire sans compétence en programmation

vive les colonnes de pointage

OK merci a toi

Mais comment j'applique ta formule a ma liste d'adresses ?

tu ouvres ton .txt avec Excel (séparateur = tabulations)

tu colles les formules de la première ligne de toto.xls dans ta première ligne intéressante (Espa france) et tu les étends vers le bas sur toute la hauteur voulue

menu données filtre automatique, clic sur la petit flèche en tête de colonne B et tu choisis "non vide"

Bonsoir,

construire un listing comme cela :

"Nom", "EMAIL", "WEB".

Les autres informations ne t'intéressent pas ? (adresse, Tel, etc...)

Certains noms n'ont pas de Web, d'autres pas de Email, qu'est-ce qu'on fait ?

Précise

Amicalement

Claude

Oui c'est vrais c'est pas pratique si y a pas de mail

Mais en réalité c'est une liste de client a contacter par mail donc si ils n'ont pas de mail le plus simple c'est de le supprimer de la liste

cordialement,

stefart

ma méthode des colonnes de pointage donne le résultat demandé au départ

merci jmd

C'est sans doute vrais mais je sais pas comment mettre ta méthode en pratique ?

Bonsoir à tous,

En attendant de comprendre la méthode à jmd, voici en VBA

Ne prend en compte que les noms avec Email (certains sont vides)

Fait une copie de la feuille avant de lancer la macro

Sub Email()
'Macros par Claude Dubois pour "stefart" Excel-Pratique le 18/06/10
Dim Lg%, i%, x%, y%, A%, z$, Sp, Sp2
    Lg = Range("A65536").End(xlUp).Row
        Application.ScreenUpdating = False
    For i = 2 To Lg
        x = Cells(i, 1).End(xlDown).Row
        On Error GoTo Fin
        y = Cells(x, 1).End(xlDown).Row
        z = Left(Cells(y, 1), 3)
        A = Application.Match(z & "*", Range("a" & x & ":a" & y), 0) + x - 1
        If z = "EMA" Then
            Sp = Split(Cells(y, 1), " : ")
            Cells(x, 2) = Cells(x, 1) 'nom
            If Len(Cells(y, 1)) > 7 Then Cells(x, 4) = Sp(UBound(Sp)) 'eMail
            If Left(Cells(A - 1, 1), 3) = "WEB" Then
                Sp2 = Split(Cells(y - 1, 1), " : ")
                Cells(x, 3) = Sp2(UBound(Sp2)) 'web
            End If
        End If
        i = y
    Next i
Fin: 'garanti la dernière boucle .End(xlDown)
    Range("b2:b" & Lg).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    Columns(1).Delete
    Range("a:c").Columns.AutoFit
End Sub

édit: je m'aperçois en postant que j'ai mis Nom; Web, Email au lieu de Nom; Email; Web

on peut changer si tu veux !

Amicalement

Claude

tu ouvres le txt avec excel (séparateur tabulation)

tu colles les formules que je t'ai fournies, et tu les copies dans toutes les lignes (en faisant glisser vers le bas)

puis menu données, filtrer filtre automatique et tu choisis sur la colonne B (la colonne des noms d'entreprises) "non vide"

terminé

Bonsoir à tous,

Au cas ou, version avec tous les champs

ici exemple avec 4 adresses , les données sont "bidons"

J'ai supprimé le fichier de mon message précédent pour confidentialité

Sub Email()
'Macros par Claude Dubois pour "stefart" Excel-Pratique le 19/06/10
Dim Lg&, i%, x%, y%, Sp
Dim J As Byte, Cl As Byte, z$, Sep$
        If Cells(3, 1) <> "" Then Exit Sub
        Application.ScreenUpdating = False
        Lg = Range("A65536").End(xlUp).Row
    For i = 2 To Lg
            x = Cells(i, 1).End(xlDown).Row 'première ligne Bloc
            y = Cells(x, 1).End(xlDown).Row 'dernière ligne Bloc
            i = y
        For J = 0 To 4
            z = Left(Cells(y - J, 1), 3)
                Select Case z
                    Case Is = "EMA": Cl = 9: Sep = " : " 'Cl = colonne
                    Case Is = "WEB": Cl = 8: Sep = " : "
                    Case Is = "FAX": Cl = 7: Sep = " :"
                    Case Is = "GSM": Cl = 6: Sep = " :"
                    Case Is = "TEL": Cl = 5: Sep = " :"
                    Case Else: Exit For
                End Select
            Sp = Split(Cells(y - J, 1), Sep)
            Cells(x, Cl) = Sp(UBound(Sp))
        Next J

                Cells(x, 2) = Cells(x, 1)       'nom
                Cells(x, 3) = Cells(x + 1, 1)   'adresse
                Cells(x, 4) = Cells(x + 2, 1)   'ville
    Next i
                Range("b2:b" & Lg).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
                Columns(1).Delete
                ActiveWindow.Zoom = 80: Range("a1").Activate
                Range("a:h").Columns.AutoFit
End Sub

Amicalement

Claude

Bonsoir,

stefart, çà valait pour le moins une réponse !

Je t'ai pourtant vu passer sur le forum depuis

pas sympa çà !

Claude

Oui excuse-moi claude,

En effet c'est pas sympa de ma part. mais j'ai pas eu le temps de tester completement ta macros.

J'etais en formation les semaines passées.

Un grand merci a toi et excuse encore mon impolitesse.

Stef

-- 28 Juin 2010, 01:03 --

Bonsoir Claude,

en effet ta macros marche super bien !

Je rencontre juste une petites erreurs lorsque je lance la macros sur mes 4000 adresse clients.

Si je la lance sur moins de 1000 ca marche super.

Je sais pas sis ca viens de ma machine ou quoi ?

Voici le message d'erreur en question :

" erreur 6 depassement capacité "

Enfin c'est pas bien grave je le lancerais en plusieurs étapes.

Juste encore une petites question. A ton avis est il possible de supprimer les doublons de la liste ?

Et si oui comment faire ?

1000 Merci a toi

Stef

Bonjour,

" erreur 6 depassement capacité "

Dans le code de Claude, remplace :

Dim Lg&, i%, x%, y%, Sp

par :

Dim Lg&, i&, x&, y&, Sp

Dans la déclaration des variables, seul Lg est déclaré en Long

Ci-dessous un autre code, qui n'oblige pas à coller le fichier texte dans une feuille.

Il te suffit de mettre le chemin de ton fichier, ainsi que son nom, dans la ligne :

Open "C:\Users\TonNom\Rep1\Rep2\Fichier.txt" For Input As #1

Plus de doublons, non plus

le code :

Sub lireFichierTexte()
Dim Ligne As String
Dim DerCell As Range
Dim Flag As Boolean
Application.ScreenUpdating = False
Open "C:\Users\TonNom\Rep1\Rep2\Fichier.txt" For Input As #1
Set DerCell = [A65000].End(xlUp)(2)
Do While Not EOF(1)
    Line Input #1, Ligne
    If Ligne = "" Then
        Flag = False
        GoTo suite
    End If
    If Not Flag Then
        Set DerCell = [A65000].End(xlUp)(2)
        DerCell.Value = Ligne
        Flag = True
    End If
    If Left(Ligne, 3) = "WEB" Then
        If Len(Ligne) > 6 Then DerCell.Offset(0, 1).Value = Right(Ligne, Len(Ligne) - 6)
    End If
    If Left(Ligne, 5) = "EMAIL" Then
        If Len(Ligne) > 8 Then DerCell.Offset(0, 2) = Right(Ligne, Len(Ligne) - 8)
    End If
suite:
Loop
Close #1
Columns(3).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Range("A1:C" & [A65000].End(xlUp).Row).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
        "D1"), Unique:=True
Columns("A:C").Delete
Columns("A:C").AutoFit
End Sub

le fichier :

Bonne semaine

Bonjour à tous, Salut cousinhub,

Stef, je t'ai fait 2 versions,

une avec seulement Nom, Web et email

l'autre avec tous les champs (Adresse, Tel etc…)

---- questions ----

1) de laquelle parles-tu et préfère-tu ?

2) pour les doublons, çà dépendra de ta réponse à la question 1)

pour le bug, je m'en occupe.

Rappel: tu devrais supprimer du forum, ton fichier avec les 4300 adresses (si confidentiel)

à te relire

Amicalement

Claude.

ok merci claude pour ta réponse

J'ai utilisé le xls avec tous les champs

Ps: tu a raison j'ai supprimé le fichier adresse c'est plus prudent.

-- 28 Juin 2010, 13:26 --

merci a toi aussi cousinhub

re,

Donc si je résume,

On garde tous les champs, Ok

------ Maintenant pour les doublons ------

Sur le fichier d'origine, sur les 4300 lignes, il n'y a que 3 vrais doublons, c'est à dire

en prenant en compte toutes les colonnes, (email identiques mais adresses différentes)

C'est sans doute pas çà que tu veux !

On pourrait ne conserver que les noms ayant un email et sans doublon, non ?

Tant pis pour les adresses et Web n'ayant pas d'email ou email identique.

Précise ce point

Amicalement

Claude

oui sur le listing final il y a d'autres adresse qui sont en doublons.

Le mieux serais donc de garder les fiche clients complètes et de supprimer les fiche sans mails ou en doublons(mail), afin d'obtenir un fichiers clients propre.

Surtout que je risque dans un mois avoir a refaire un mailing avec d'autres adresse, qui auront sans doute aussi des doublons ou bien pas d'adresse mail.

merci a toi

Stef