Mail Transfère par Domaine sur une même feuille dans un tableau

**meryn** · 02/04/2012, 14h06

Bonjour !
j'ai un soucis :
j'ai un code vba qui réorganise des mails par domaine ( fr, com, tn, net,...)
dont chaque domaine est dans une feuille.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
Private Sub transferer1_Click()
 'Déclarations
    Dim wsSource As Worksheet
    Dim wsNew As Worksheet
    Dim i As Integer
    Dim domaine As Variant
    Dim adresseMail As Variant
    Dim positionPoint As Integer
    Dim dicDom As Object
    Dim lMail As Collection
 
    'Initialisations
    Set wsSource = Worksheets("Mail Personnel")
    Set wsSource = Worksheets("Mail Professionel")
    Set dicDom = CreateObject("Scripting.Dictionary")
 
    'On boucle dans la colonne A pour répertorier tous les mails
    i = 1
    adresseMail = wsSource.Cells(i, "A").Value
 
    Do While adresseMail <> "" 'Tant qu'on a des mails
 
        'On récupère la position du dernier point dans le contenu de la cellule
        positionPoint = InStrRev(adresseMail, ".")
        'On en déduit le domaine
        domaine = Mid(adresseMail, positionPoint + 1, Len(adresseMail) - positionPoint + 1)
 
        'Si le domaine n'existe pas, on le crée
        If Not dicDom.Exists(domaine) Then
            Set lMail = New Collection
            dicDom.Add domaine, lMail
        End If
 
        'On ajoute le mail dans la collection correspondante
        Set lMail = dicDom(domaine)
        lMail.Add adresseMail
 
        i = i + 1
        adresseMail = wsSource.Cells(i, "A").Value
 
    Loop
 
    'Maintenant, on va créer les feuilles correspondantes et entrer les mails
    For Each domaine In dicDom.Keys
 
        'Création de la feuille
        Set wsNew = Worksheets.Add()
       ' wsNew.Name = domaine
 
        'Ajout des mails
        Set lMail = dicDom(domaine)
        i = 1
        For Each adresseMail In lMail
            wsNew.Cells(i, "A").Value = adresseMail
 
            i = i + 1
        Next adresseMail
 
    Next domaine
    Unload Me
End Sub

ce que je désire c'est avoir tout ces mails de domaine differentes classé dans un tableau, sur une même feuille. auriez-vous une idée, merci de votre aide.
venez en aide d'un frère qui est dans le besoin svp !

**Jean-Philippe André** · 03/04/2012, 14h02

salut,

ton problème peut déjà se situer ici:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

wsNew.Cells(i, "A").Value = adresseMail

Cells() prends des paramètres de type numérique entier, pas des lettres

La syntaxe est du type
Cells(numeroligne,numerocolonne)
voir l'aide en ligne

à ce sujet

Il te faudra donc déjà remplacer cette ligne par

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

wsNew.Cells(i, 1).Value = adresseMail

**meryn** · 03/04/2012, 15h59

j'ai apporté tes modifacations, j'en suis encore au même resultat.

**Jean-Philippe André** · 03/04/2012, 16h18

Si tu n'es pas plus explicite dans tes messages, ca ne donne aucune envie de te venir en aide. Soit tu fais un effort pour nous aider, soit tu te débrouilels tout seul, merci !

Meme chose que mon précédent poste pour

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

adresseMail = wsSource.Cells(i, "A").Value

devant devenir

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

adresseMail = wsSource.Cells(i, 1).Value

**meryn** · 03/04/2012, 17h18

Merci ! je vient de le remplacer, ça marche bien, mais ça crée des feuilles avec avec des mails classé par domaine (fr, com, tn, net,...). ce que je veux c'est transférer des mails par domaine, sur la même feuille, les classés dans un tableau par ordre de domaine (fr, com, tn,...) ou une solution qui peut m'aider. car j'ai essayé de trouver par moi même une solution, mais sans succès. je vous remercie de m'apporter votre aide.

**meryn** · 08/04/2012, 01h01

Bonsoir !
je désire avoir tous mes mails classé par ordre domaine sur une même feuille.

exemple: dans la colonne:

A les adresses mails de domaine "fr"
B les adresses mails de domaine "com"
C les adresses mails de domaine "net"
D les adresses mails de domaine "tn"
E les adresses mails de domaine "eu"
F .............

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
Private Sub transferer1_Click()
 'Déclarations
    Dim wsSource As Worksheet
    Dim wsNew As Worksheet
    Dim i As Integer
    Dim domaine As Variant
    Dim adresseMail As Variant
    Dim positionPoint As Integer
    Dim dicDom As Object
    Dim lMail As Collection
 
    'Initialisations
    Set wsSource = Worksheets("Mail Personnel")
    Set wsSource = Worksheets("Mail Professionel")
    Set dicDom = CreateObject("Scripting.Dictionary")
 
    'On boucle dans la colonne A pour répertorier tous les mails
    i = 1
    adresseMail = wsSource.Cells(i, "A").Value
 
    Do While adresseMail <> "" 'Tant qu'on a des mails
 
        'On récupère la position du dernier point dans le contenu de la cellule
        positionPoint = InStrRev(adresseMail, ".")
        'On en déduit le domaine
        domaine = Mid(adresseMail, positionPoint + 1, Len(adresseMail) - positionPoint + 1)
 
        'Si le domaine n'existe pas, on le crée
        If Not dicDom.Exists(domaine) Then
            Set lMail = New Collection
            dicDom.Add domaine, lMail
        End If
 
        'On ajoute le mail dans la collection correspondante
        Set lMail = dicDom(domaine)
        lMail.Add adresseMail
 
        i = i + 1
        adresseMail = wsSource.Cells(i, "A").Value
 
    Loop
 
    'Maintenant, on va créer les feuilles correspondantes et entrer les mails
    For Each domaine In dicDom.Keys
 
        'Création de la feuille
        Set wsNew = Worksheets.Add()
       ' wsNew.Name = domaine
 
        'Ajout des mails
        Set lMail = dicDom(domaine)
        i = 1
        For Each adresseMail In lMail
            wsNew.Cells(i, "A").Value = adresseMail
 
            i = i + 1
        Next adresseMail
 
    Next domaine
    Unload Me
End Sub

Merci

et bonne soirée à toute

**mercatog** · 08/04/2012, 10h30

Remplace la partie juste après la ligne 42 de ton dernier code. Dans chaque colonne d'une feuille nouvelle tu auras les adresses de chaque domaine.

PS: J'ai supposé que ton code fonctionnait mais rapatriait les adresses de chaque domaine dans une feuille différente.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
'Création de la feuille
Set wsNew = Worksheets.Add()
'Maintenant, on va créer les feuilles correspondantes et entrer les mails
For Each domaine In dicDom.Keys
    j = j + 1
    'Ajout des mails
    Set lMail = dicDom(domaine)
    i = 1
    For Each adresseMail In lMail
        wsNew.Cells(i, j).Value = adresseMail
        i = i + 1
    Next adresseMail
Next domaine

PS2. La lignes 14 de ton code annule la ligne 13, tu travailles donc seulement avec la feuille Mail Professionnel

**meryn** · 08/04/2012, 11h26

Bonjour ! merci, vous dite que
La lignes 14 de mon code annule la ligne 13, donc je travailles seulement avec la feuille Mail Professionnel. y a-t-il un moyen de résoudre ce problème, je veux dire travailler avec les deux feuilles. bonne journée

**mercatog** · 08/04/2012, 11h33

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
Private Sub transferer1_Click()
Dim Domaine As Variant, AdresseMail As Variant
Dim wsSource As Worksheet, wsNew As Worksheet
Dim i As Integer, j As Integer
Dim LMail As Collection
Dim DicDom As Object
 
'Initialisations
Set DicDom = CreateObject("Scripting.Dictionary")
 
For Each wsSource In Worksheets(Array("Mail Personnel", "Mail Professionel"))
    'On boucle dans la colonne A pour répertorier tous les mails
    AdresseMail = wsSource.Cells(1, 1).Value
    i = 1
    Do While AdresseMail <> ""                   'Tant qu'on a des mails
        Domaine = Mid(AdresseMail, InStrRev(AdresseMail, ".") + 1)
        'Si le domaine n'existe pas, on le crée
        If Not DicDom.Exists(Domaine) Then
            Set LMail = New Collection
            DicDom.Add Domaine, LMail
        End If
        'On ajoute le mail dans la collection correspondante
        Set LMail = DicDom(Domaine)
        LMail.Add AdresseMail
        i = i + 1
        AdresseMail = wsSource.Cells(i, 1).Value
    Loop
Next wsSource
 
'Création de la feuille
Set wsNew = Worksheets.Add(After:=Sheets(Sheets.Count))
'Maintenant, on va créer les feuilles correspondantes et entrer les mails
For Each Domaine In DicDom.Keys
    j = j + 1
    'Ajout des mails
    Set LMail = DicDom(Domaine)
    i = 1
    For Each AdresseMail In LMail
        wsNew.Cells(i, j).Value = AdresseMail
        i = i + 1
    Next AdresseMail
Next Domaine
Set wsNew = Nothing
Set DicDom = Nothing
Set LMail = Nothing
End Sub

**meryn** · 08/04/2012, 12h49

Bonjour ! mon problème est résolu, grace à vous merci

Mail Transfère par Domaine sur une même feuille dans un tableau

Macros et VBA Excel

Discussions similaires

Partager

Partager