Discussion :

[babybell]

Amis du forum bonjour

Après maintes recherches vaines, je me tourne vers vous.

Dans un fichier, j'ai plusieurs colonnes.

agences noms a noms b
1 a aaaaaa
2 b bbbbbb
3 c cccccc
4 d aaaaaa
5 e aaaaaa
6 f bbbbbb
7 g cccccc
8 h cccccc
9 i cccccc

Comme vous le voyez, dans la 3ème, il y a des noms semblables(il y en a beaucoup plus). Lorsque je veux envoyer un mail à chaque agence de la colonne A, comment faire pour ne l'envoyer qu'une seule fois à une personne de la colonne C, comme cela :

agences noms a noms b
1 a aaaaaa
4 d
5 e
2 b bbbbbb
6 f
3 c cccccc
7 g
8 h
9 i

Ais-je été assez clair ?

Merci pour voter aide.

[MarcelG]

Bonjour Babybell et le Forum,

Si tu souhaites éliminer les doublons de ta 3ème colonne depuis la ligne 1

(à adapter-voir commentaires)

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
Sub Suppression_Doublons()
' suppression de doublons dans la colonne CTR
' depuis la ligne LD jusqu'à la dernière ligne occupée LF
  CTR = 3
  LD = 1
  Application.ScreenUpdating = False
  LF = Columns(CTR).Find("*", Cells(1, CTR), , , , xlPrevious).Row
  Set Plage = Range(Cells(LD, CTR), Cells(LF, CTR))
  For n = LD To LF
    If NBSI(Plage, Cells(n, CTR).Value) > 1 Then Cells(n, CTR).ClearContents
  Next
  ' Tri par ordre croissant
  Plage.Sort Key1:=Cells(LD, CTR), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End Sub
 
Function NBSI(ByVal Tableau As Range, ByVal Val_Test As String) As Variant
' fonctionnement identique à la fonction NB.SI de feuille de calcul
  NBSI = 0
  If IsError(Application.WorksheetFunction.CountIf(Tableau, "=" & Val_Test)) = False Then
    NBSI = Application.WorksheetFunction.CountIf(Tableau, "=" & Val_Test)
  End If
End Function

[babybell]

Merci MarcelG de ta réponse, mais ce n'est pas cela que je veux.

Je ne veux pas les éliminer de ma liste, je ne voudrais simplement ne leur envoyer un mail qu'une seule fois, et non autant de fois que leur nom apparait dans ma colonne.

[MarcelG]

Babybel,

Tu adaptes la ligne de code

Code :

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

If NBSI(Plage, Cells(n, CTR).Value) > 1 Then Cells(n, CTR).ClearContents

en

Code :

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

If NBSI(Plage, Cells(n, CTR).Value) <= 1 Then 'ta macro d'envoi de mail'

et tu supprimes le code concernant le tri

[MarcelG]

Babybell,

Je reviens.

Tu peux créer une quatrième colonne dont chaque valeur est égale à la cellule de la même ligne en colonne 3, et affecter le code à cette 4ème colonne.

Ta macro d'envoi de mail s'adaptera à cette quatrième colonne

Ce qui donne

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
Sub Suppression_Doublons()
' suppression de doublons dans la colonne CTR
' depuis la ligne LD jusqu'à la dernière ligne occupée LF
  CTR = 4
  LD = 1
  Application.ScreenUpdating = False
  LF = Columns(CTR).Find("*", Cells(1, CTR), , , , xlPrevious).Row
  Set Plage = Range(Cells(LD, CTR), Cells(LF, CTR))
  For n = LF To LD Step -1
    If NBSI(Plage, Cells(n, CTR).Value) > 1 Then Cells(n, CTR).ClearContents
   Next
   For n = LD To LF
        If Not IsEmpty(Cells(n, CTR)) Then 'ta macro envoi de mail
   Next
End Sub
 
Function NBSI(ByVal Tableau As Range, ByVal Val_Test As String) As Variant
' fonctionnement identique à la fonction NB.SI de feuille de calcul
  NBSI = 0
  If IsError(Application.WorksheetFunction.CountIf(Tableau, "=" & Val_Test)) = False Then
    NBSI = Application.WorksheetFunction.CountIf(Tableau, "=" & Val_Test)
  End If
End Function

[babybell]

Merci à toi, bonne journée.

[babybell]

Encore moi.

Je viens de m'apercevoir que je suis obligé, pour envoyer mes mails, de masquer certaines lignes. Lorsque j'utilise ton code, il supprime même les noms dans les lignes cachées.
Est-il possible de n'enlever que les noms des lignes apparentes ?

Merci encore.

[Godzestla]

Bonjour,
cela change la donne.

Pourquoi dans ce cas ne pas traiter les doublons au moment du mailing.

Tu ne précises nullement si le mail à envoyer est unique (global), s'il est identique ou s'il est spécifique à chaque ligne.

Dans l'optique où le mail est unique ou identique, je te suggère de simplement mettre tes contacts (email) en table au moment de leur utilisation.

Principe :
table vide au départ
contact à traiter -> Déjà dans la table -> Oui -> Suivant
Sinon, met le contact en table et le traite.

Les solutions les plus fiables sont parfois les plus basiques.

[babybell]

merci Godzestla, mais n'ayant encore fait de mises en tables, pourrais-tu m'aider en me donnant un exemple simple ?

Merci d'avance

[Maxence HUBICHE]

Tu peux aussi imaginer qu'avant l'envoie, tu mets tes infos dans une collection, en définissant la key
Si la key apparait en doublon => erreur
Or, le traitement de l'erreur devient tout simple => on n'envoie pas, et on passe au suivant

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
Option Explicit
 
Sub EnvoyerMails()
    Dim oSource               As Range
    Dim oEnvoi                As Range
    Dim oColl                 As Collection
    Dim bContinue             As Boolean
 
    'Définition des objet
    On Error GoTo EnvoyerMails_Error
 
    Set oSource = Feuil2.UsedRange
    Set oColl = New Collection
 
    'Parcours
    For Each oEnvoi In ActiveSheet.UsedRange.Columns(3).Cells
        'Mise à vrai de la variable de continuation
        bContinue = True
        'tentative de l'ajout à la collection
        oColl.Add oEnvoi.Value, oEnvoi.Value
        'si on doit continuer
        If bContinue Then
            'ICI, PROCEDER A L'ENVOI
            'MsgBox oEnvoi.Value
            'sinon
        Else
            'rien à faire, on passe à la ligne suivante
        End If
    Next
EnvoyerMails_Fin:
    On Error GoTo 0
    Exit Sub
EnvoyerMails_Error:
    Select Case Err.Number
        Case 457                                           'Tentative d'ajout d'une clé existante
            bContinue = False
            Resume Next
        Case Else
            MsgBox "Erreur N°" & Err.Number & " (" & Err.Description & ") dans la procédure EnvoyerMails de Module1"
    End Select
    Resume EnvoyerMails_Fin
End Sub

[EDIT]
Désolé, j'ai fait le code avant de voir ce que tu as proposé.
Mais bon... avec un peu d'adaptation...
Par exemple, au lieu de faire les UsedRange, utiliser les SpecialCells pour obtenir uniquement les cellules visibles, après ton filtre
Et aussi, au lieu d'utiliser la 3ème colonne (d'après ton premier exemple) utiliser la 9ème (I)
...
Bref, voilà de quoi faire rapidement ton travail.
C'est testé sur ton premier exemple, et cela fonctionne

++
[/EDIT]