Macro sous excel 2003 pour ranger les donnees

ks13 Messages postés 191 Statut Membre -  
ks13 Messages postés 191 Statut Membre -
Bonjour,

j'ai commence a travailler dans une nouvelle entreprise recemment, et apres le tour des differents postes, j'ai remarque que la gestion des adresses e-mail se fait manuellement. Apres quoi on m'a demande de trouver une macro pour faciliter le travail.

La 1ere partie du travail de nettoyage des adresses consiste a separer les adresses e-mail des noms et prenoms, le contenu d'une cellule et comme suit : "Nom Prenom <nomprenom@fournisseur.com>" (il n'y a pas d'aiguillements et et l'adresse mail est toujours entre < et >. Aussi, des fois quand la personne en charge copie les adresses -mail de l'e-mail envoye par un vendeur elles sont rangees toutes dans une ligne (ex. 1ere adresse ligne 1 colonne 1, 2eme adresse ligne 1 colonne 2 etc). Le but de la macro est de ranger les adresse verticalement (si il y a besoin) et de serparer les adresses mail des noms et prenoms. Au final il devrais y avoir 2 colonnes : la 1ere pour les adresses mail sans les signes < et > et la 2eme contenant les noms et prenoms (si il y en a, car les personnes les envoyant oublient des fois de mettre le nom et le prenom.

La 2eme partie du travail consistera a realiser 2 listes d'adresses mail dans la meme forme que pour la tache precedente (Colonne 1 adresses mail, colonne 2 noms et prenoms). Le fichier comporte autant de feuilles que de personnes donnant les adresses mails (ce sont les vendeurs qui les ajoutent, pas les clients) plus 2 feuilles : Nouvelles (pour les adresses ajoutees depuis la derniere modification du fichier) et Toutes (la liste complete de toutes les adresses depuis la creation du fichier). Si possible, aussi verifier que l'adresse e-mail de la cellule a un format correct (des fois il y a des virgules a la fin, ce qui fausse la recherche des doublons)

La derniere partie (enfin ^^;) consistera a ranger les adresses par odre alphabetique et effacer les doublons (de preference la ligne n'ayant pas le nom et le prenom car certains doublons n'ont rien dans la 2eme colonne et leur copie si). Au pire, il suffirait de changer la couleur des cellules doublons pour etre visibles facilement.

Alors, cela en fait du boulot. Autre precision, le fichier pour la 1ere partie et le fichier pour la 2eme et 3eme partie ne sont pas les memes, car la personne copie d'abord les adresses depuis l'e-mail recu par un vendeur, puis les met en forme, et ensuite les ajoute au fichier contenant toutes les adresses mail (ce sont ces adresses qui vont dans la feuille des nouvelles adresses).

Mon majeur probleme c'est que je n'ai pas assez de notions en basic pour faire 2-3 macros faisant cela. Je crois me souvenir qu'on pouvais faire reference a des donnees dans une autre feuille excel, donc je pense que la 1ere macro pourrais ajouter les nouvelles adresses dans le fichier principal, apres quoi la 2eme macro finira le travail. Le probleme ici c'est que dans la version 2003 d'excel il n'y a pas de fonction automatique pour virer les doublons, presente dans la version 2007 ou superieur.

La raison du besoin de cette macro c'est la grande quantitee d'adresses a traiter (a ce jour pres de 19000 adresses stockees).

Je sais que cela fait un mur de mots pas tres agreable a lire, mais j'ai essaye de mettre plus ou moins tout ce qu'on attends de la macro. Toutes les suggestions sont bienvenues :)

PS : j'ajouterais bien un fichier d'exemple mais je n'ai plus l'adresse du site ou on peut uloader gratuitement des fichiers, si quelqu'un l'a, ce serait gentil de me le rappeler.

A voir également:

35 réponses

lermite222 Messages postés 9042 Statut Contributeur 1 191
 
Sub Trie()
Dim Lig As Long
Dim Cel As Range, Plage As Range
Dim TB
    Set Plage = Sheets("Feuil1").Range("A1:" & Sheets("Feuil1").Range("A1").SpecialCells(xlCellTypeLastCell).Address)
    Lig = 1
    With Sheets("Feuil2")
    On Error Resume Next
    For Each Cel In Plage
        If Cel <> "" Then
            TB = Split(Cel, "<")
            If UBound(TB) = 1 Then
                .Cells(Lig, 1) = "<" & TB(1): .Cells(Lig, 2) = TB(0)
            Else
                .Cells(Lig, 1) = "<" & TB(0)
            End If
            Lig = Lig + 1
        End If
    Next
    End With
End Sub

Où j'ai pas bien compris, tu veux garder les "< >" ou pas.
1
lermite222 Messages postés 9042 Statut Contributeur 1 191
 
Bonjour,
Cjoint.com
et mettre le lien dans un poste suivant.
A+
0
ks13 Messages postés 191 Statut Membre 23
 
Alors, merci lermite pour le lien, voici donc le lien de fichier avant le rangement des adresses : https://www.cjoint.com/?hcpck4CBZj

Ensuite ce a quoi devrais ressembler la page une fois rangee (les adresses ne sont pas les memes car je n'ai pas beaucoup de temps entre 2 taches ^^;) : https://www.cjoint.com/?hcppxoYMCl

Voici donc a quoi ressemble le grand fichier apres l'ajout des nouvelles adresses (y en a pas beaucoup encore par manque de temps) : https://www.cjoint.com/?hcpro0ONWm

Et voici enfin a quoi devrait ressembler le fichier une fois le rangement fini : https://www.cjoint.com/?hcpr78PbD0

J'espere que cela explique mieu le boulot a faire que mon mur de mots ^^
0
ks13 Messages postés 191 Statut Membre 23
 
Alors, merci lermite pour le lien, voici donc le lien de fichier avant le rangement des adresses : https://www.cjoint.com/?hcpck4CBZj

Ensuite ce a quoi devrais ressembler la page une fois rangee (les adresses ne sont pas les memes car je n'ai pas beaucoup de temps entre 2 taches ^^;) : https://www.cjoint.com/?hcppxoYMCl

Voici donc a quoi ressemble le grand fichier apres l'ajout des nouvelles adresses (y en a pas beaucoup encore par manque de temps) : https://www.cjoint.com/?hcpro0ONWm

Et voici enfin a quoi devrait ressembler le fichier une fois le rangement fini : https://www.cjoint.com/?hcpr78PbD0

J'espere que cela explique mieu le boulot a faire que mon mur de mots ^^

(Desole pour la reponse tardive, j'avais repondu de suite mais je l'ai mis dans commentaires au lieu de clicker sur le bouton "j'ai une reponse", encore une fois par manque de temps car l'ordinateur avais ete requisitionne par une autre personne de l'entreprise ^^;)
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
lermite222 Messages postés 9042 Statut Contributeur 1 191
 
Avec ton modèle exemple tu as tout sur une seule ligne mais je suppose que ton classeur comporte plus d'une ligne.
J'ai supposé qu'il n'y avait que des cellules comportant tes exemples..
dupond jean <jean.dupond@free.fr>
J'ai donc sélectionné toutes les cellules renseignées de la feuille.
Tu dois adapter les noms des feuilles.
La macros prend toutes les cellules de la feuil1 et recopie tout dans les colonnes A et B de la feuil2
Tu colle ça dans un module.
Sub Trie() 
Dim Lig As Long 
Dim Cel As Range, Plage As Range 
Dim TB 
    Set Plage = Sheets("Feuil1").Range("A1:" & Sheets("Feuil1").Range("A1").SpecialCells(xlCellTypeLastCell).Address) 
    Lig = 1 
    With Sheets("Feuil2") 
    On Error Resume Next
    For Each Cel In Plage 
        If Cel <> "" Then 
            TB = Split(Cel, "<") 
            .Cells(Lig, 1) = "<" & TB(1): .Cells(Lig, 2) = TB(0) 
            Lig = Lig + 1 
        End If 
    Next 
    End With 
End Sub

Tu dis,
A+

L'expérience instruit plus sûrement que le conseil. (André Gide)
Si tu te cognes à un pot et que ça sonne creux, c'est pas forcément le pot qui est vide. ;-)(Confucius)
0
ks13 Messages postés 191 Statut Membre 23
 
Ca marche.....partiellement. Comme j'ai dit, il y a des cas ou on a pas de nom et prenom mais juste l'adresse mail (env 50% des cas). Chez moi, sur excel 2007, cela ne fait que copier l'adresse dans la colonne B, ce qui n'est pas vraiment genant, mais j'aime quand les macros sont assez bien pour faire parfaitement le travail, donc j'ai essayer d'adapter un peu ta macro, ce qui me donne la chose suivante :

Sub Trie() 
Dim Lig As Long 
Dim Cel As Range, Plage As Range 
Dim TB 
    Set Plage = Sheets("Feuil1").Range("A1:" & Sheets("Feuil1").Range("A1").SpecialCells(xlCellTypeLastCell).Address) 
    Lig = 1 
    With Sheets("Feuil2") 
    On Error Resume Next 
    For Each Cel In Plage 
        If Cel <> "" Then 
        If InStr(Cel, "<") = 0 Then .Cells(Lig, 1) = Cel Else 
        If InStr(Cel, "<") <> 0 Then 
            TB = Split(Cel, "<") 
            .Cells(Lig, 1) = TB(1): .Cells(Lig, 2) = TB(0) 
            Lig = Lig + 1 
        End If 
        End If 
    Next 
    End With 
End Sub


J'ai supprime le nom et prenom de la 1ere cellule pour tester la macro sur une adresse sans nom et prenom, et excel supprime automatiquement les "<" et ">". Donc j'ai essaye de faire une comparaison par rapport a la presence de l'un des signes, mais maintenant il omet la 1ere cellule et je ne retrouve que les autres. Je sais que cette macro prends toute la plage des cellules d'un coup et divise le texte, mais je ne suis pas sur de la facon d'ont je pourrais conditionner la division au cas par cas, d'ou ce code.
0
ks13 Messages postés 191 Statut Membre 23
 
Ah, non, je ne veux pas les garder. Hmm UBound, encore une fonction que je ne connais pas. La derniere macro que j'ai fait, j'ai essaye de m'aider du fichier Help fourni avec le programme, mais c'est pas evident de s'y retrouver, surtout quand on ne peux pas faire une recherche sur l'operation qu'effectue la fonction.

Hmm, si je vire "<" & devant les TB cela enleve les "<" devant l'adresse mais je n'arrive pas a enlever le ">' a la fin des adresses. J'ai essaye de trouver une fonction equivalente de chop() dans php mais je n'en ai pas trouve...
0
lermite222 Messages postés 9042 Statut Contributeur 1 191
 
Si tu veux enlever les "< > ", modifie...

            If UBound(TB) = 1 Then
                .Cells(Lig, 1) = Left(TB(1), Len(TB(1) - 1)): .Cells(Lig, 2) = TB(0)
            Else
                .Cells(Lig, 1) = Left(TB(0), Len(TB(0) - 1))

0
ks13 Messages postés 191 Statut Membre 23
 
Hmm, ca ne marche pas avec ton code,l'erreur viens du Len(TB(1)-1) car tb(1) est un string, et -1 est un numero. J'ai donc juste change de place de la parenthese, ce qui nous donne :

If UBound(TB) = 1 Then
                .Cells(Lig, 1) = Left(TB(1), Len(TB(1)) - 1): .Cells(Lig, 2) = TB(0)
            Else
                .Cells(Lig, 1) = Left(TB(0), Len(TB(0)) - 1)


Enfin, merci pour l'aide sur la 1ere Macro ^^. Maintenant il ne manque que la 2eme macro, j'ai retrouve 2 macros anciennes qui utilisent le reclassement des donnees sur une page donnee, le probleme c'est que ce n'est pas evident d'adapter le code ^^;
0
ks13 Messages postés 191 Statut Membre 23
 
Euh, tu a ecrit Left(TB(1), Len(TB(1) - 1)), moi j'ai mis ce que tu viens d'ecrire ^^;
0
lermite222 Messages postés 9042 Statut Contributeur 1 191
 
OK, tu as raison, la parenthèse était mal placée.
0
ks13 Messages postés 191 Statut Membre 23
 
Bonjour, je manque de temps pour m'occuper de la macro (la famille etant partie en vaccances c moi qui m'occupe de la maison u_u), mj'ai reflechi un peu a ce que la 2eme macro pourrais faire, et je pense qu'il vaudrais mieu la simplifier. Dans la feuille active, la macro verifiera toutes les adresses de la 1ere colonne en cherchant 2 choses :

- Le format correct de l'adresse (la 1ere macro n'enlevais que les signes "<" et ">")

- La repetition de l'adresse (un dedoublonage) en supprimant, de preference, les lignes qui n'ont pas de nom et prenom

J'ai cherche dans ce forum des macros de dedoublonage, mais aucune avais le parametre pour supprimer une ligne si elle manquais de donnees quelque part. Il y a aussi cette verification des adresses, en php il y a une commande pour cela, mais je ne me souviens pas avoir vu une commande similaire en Basic. Je vais m'en occuper des que je trouverais le temps. En tout cas merci Lermite pour la 1ere macro, ton aide est tres appreciee ^^.
0
lermite222 Messages postés 9042 Statut Contributeur 1 191
 
Sic
qu'il vaudrais mieu la simplifier
Où elle est cette macros ?
0
ks13 Messages postés 191 Statut Membre 23
 
Ah, elle n'existe pas encore, mais j'ai donne la description de ce que je voulais qu'elle fasse dans mon 1er post. Apres avoir reflechi, je me suis dit que si elle faisait tout cela, il y aurait trop de risques (si il y a une erreur avec la macro on s'en rendrais pas compte vu qu'on se dirait qu'elle fait tout toute seule), donc simplifier le boulot de la macro et laisser une partie en manuel.
0
lermite222 Messages postés 9042 Statut Contributeur 1 191
 
Ah bon, donc tu veux que je la cogite ?
Pas aujourd'hui, c'est dimancge et le BC m'attend. (bon appérit)
A+
0
ks13 Messages postés 191 Statut Membre 23
 
^^ merci de proposer, mais je m'en voudrais de te laisser la faire pour moi. JE vais comme meme essaye de la faire par moi meme, c'est juste que d'habitude je ne travaille pas avec basic, donc mes connaissances sont tres limitees dedans, et ce week end je n'ai pas enormement de temps a consacrer a la macro. Pour ce qui est des doublons, je pense que ranger par odre alphabetique les adresses et ensuite verifier les adresses qui se suivent devrais faire l'affaire, avec un parametre du genre :
If .Cells(Lig,2) = "" 
Then Rows(Lig).Delete
Else Rows(Lig+1).Delete


M'enfin je verrais ca quand j'aurais le temps. Et bonne apres midi ^^
0
ks13 Messages postés 191 Statut Membre 23
 
Salut, je suis de retour pour vous faire faire un autre tour....du manège des méninges :)

Donc, n'ayant pas eu le temps pour la 2eme macro encore, j'ai entrepris a faire une petite macro qui raccourcis le texte d'une cellule.

J'ai une liste de references de produits longues de 4 à 6 chiffres, et certains de ces produits ayant plusieurs couleurs (20 à 24 max) on leur a rajoute une lettre par couleur, ce qui nous donne une ref comme suit : 304678-a. Moi je dois comparer toutes les ref de 2 listes pour savoir ou est quel produit (oui ils sont pas tres organisés dans l'entreprise u_u). Donc, comme il doit y avoir 2000 ref avec les lettres a la fin, je me suis dit une macro accelererait le travail. Voici ce que j'ai obtenu jusque la :
Sub Test()
    Dim Plage As Range
    Dim Lig As Long
    Dim Cell As Range
    Dim TB
    Dim Valeur As Double
    Valeur = Application.InputBox("Donnez la longueur", Type:=1)
            If Valeur = 0 Then Exit Sub
    Set Plage = Application.InputBox("Sélectionnez une plage !", "Sélection de cellules", Type:=8)
    Lig = 1
    On Error Resume Next
    For Each Cell In Plage
            If Cell <> "" Then
            Feuil1.Cells(Lig, 4) = Left(Cell, Len(Cell) - 1)
            Lig = Lig + 1
            End If
    Next
End Sub


J'ai reutilise la macro cree plus haut, le raccourcissement du texte marche, le probleme c'est de le faire à la bonne ligne. Je n'arrive pas a placer le pointeur sur la bonne ligne. Des idees? Merci d'avance.
0
ks13 Messages postés 191 Statut Membre 23
 
Alors, apres avoir obtenu mon 1er paquet d'adresses mail a ranger, j'ai vu que la macro etait trop simple. Le probleme viens du fait que la plupart des adresses, une fois copies dans la feuille excel, se retrouvent a plusieures sur une meme celule, et un petit nombre n'a pas de "<" et ">", ni de nom d'ailleurs. Donc, j'ai pense qu'il faudrais ajouter une inputbox pour demander le ou les signes sur lequels fractionner le texte de chaque cellule, avant de les ranger dans Feuil2. Je sais comment faire une inputbox, le probleme c'est que je n'ai aucune idee comment fractionner un texte en se basant sur plusieurs caracteres differents, j'ai lu l'info du Split sur l'aide Visual Basic, et cette fonction semble n'utiliser qu'un seul charactere. Y a t il un moyen d'en utiliser plusieurs?

Pour le moment j'ai pense faire un debut comme suit :

Sub Test()
    Dim Plage As Range
    Dim Lig As Long
    Dim Cell As Range
    Dim Chars
    Dim TB
    Dim Valeur As Double
    Dim Qte As Long
    Dim Tour As Long

    Qte = Application.InputBox("Combien de caracteres pour le fractionnement?", Type:=1)
            If Valeur = 0 Then Exit Sub
Tour = 1
Do While Tour <> Qte 
Set Chars(Tour) = Application.InputBox("Indiquez le charactere a chercher :", Type:=x)
Tour = Tour + 1
Loop
Set Plage = Sheets("Feuil1").Range("A1:" & Sheets("Feuil1").Range("A1").SpecialCells(xlCellTypeLastCell).Address)
    Lig = 1


Pour le moment je n'ai pas la suite, et je ne sais pas quel type mettre dans inputbox ou on entre le charactere, mais j'espere que je n'ai pas commis d'erreur.
0
ks13 Messages postés 191 Statut Membre 23
 
Resalut, j'ai resolu le probleme de la macro pour raccourcir les valeurs des champs, cela me donne ce qui suit :
Sub Test()  
    Dim Plage As Range  
    Dim Cell As Range  
    Dim Valeur As Double  
    Valeur = Application.InputBox("Donnez la longueur", Type:=1)  
            If Valeur = 0 Then Exit Sub  
    Set Plage = Application.InputBox("Sélectionnez une plage !", "Sélection de cellules", Type:=8)  
    On Error Resume Next  
    For Each Cell In Plage  
            If Cell <> "" Then  
            Cell = Left(Cell, Len(Cell) - Valeur)  
            End If  
    Next  
End Sub


J'ai aussi fait une version sans demande de selection de plage :
Sub Test()  
    Dim Plage As Range  
    Dim Cell As Range  
    Dim Valeur As Double  
    Valeur = Application.InputBox("Donnez la longueur", Type:=1)  
            If Valeur = 0 Then Exit Sub  
    Set Plage = Selection  
    On Error Resume Next  
    For Each Cell In Plage  
            If Cell <> "" Then  
            Cell = Left(Cell, Len(Cell) - Valeur)  
            End If  
    Next  
End Sub


Par contre je n'ai toujours pas de solution pour ma macro de separation de texte sur une base de plusieurs caracteres. Des idees?
0
lermite222 Messages postés 9042 Statut Contributeur 1 191
 
Si j'ai bien compris, tu cherche à supprimer le "<" et le ">"
Je ne vois que de faire en 2 passes
Cells(Lig,Col)=Replace(Cells(Lig,Col),"<","")
Cells(Lig,Col)=Replace(Cells(Lig,Col),">","")


A+
0
ks13 Messages postés 191 Statut Membre 23
 
Non, en fait, comme je l'ai explique, apres avoir recu ma 1ere liste d'adresses mail a ranger, j'ai vu qu'il y en a qui sont differentes des condition que j'avais vu dans l'exemple qu'on m'a montre et que j'ai cite ici. Il y a des cas ou il n'y a que des adresses mail sans les noms et sont separees par une virgule ou un point virgule, d'autres n'ont pas les "<" et ">". Donc, je pensais deja mettre un choix de caractere pour la separation des adresses ("," ou ";" ou un autre signe, dependant de ce qui est utilise. Ensuite suelement separer les noms des adresses, si il y a des noms. Ce que je sais commun dans tous les cas, c'est que, quand il y en a, les noms sont toujours a gauche des adresses. Chaque adresse comporte un "@". Donc je pensais faire une macro qui decoupe le texte par les separateurs (",", ";", etc), apres quoi il suffirait de chercher "@", couper tout ce qu'il y a a gauche a partir du 1er espace a gauche de "@" et le coller dans la colonne B et le reste dans la colonne A. Je ne sais pas si il y a un moyen plus simple, mais pour le moment je n'ai trouve que cela.
0