XL 2013 Supprimer doublons au vol dans un For next

[Mak_tarmak]

Bonjour,

Je sollicite votre aide pour m’aiguiller dans ma recherche.

Pour illustrer mes propos je vous joins un fichier anonymisé qui peut contenir beaucoup plus de lignes qu’il n’en contient actuellement et une copie écran du résultat que j’obtiens



Colonne A et B : Nom et Prénom d’un stagiaire

Colonne C : son mail personnel

Colonne D : nom de son responsable hiérarchique

Colonne E : mail du responsable hiérarchique

Colonne F : nom et prénom de l’assistante commerciale



Dans mon fichier, il y a la macro sample que j’ai trouvé sur le forum et que j’ai réussi à adapter pour mon cas.

A savoir :

• récupérer toute la liste des mails des stagiaires dans la variable Sdest pour les mettre dans le champ A du message à envoyer
• récupérer toute la liste des mails des responsables hiérarchiques dans Sdest2 et la liste des assistantes dans Sdest3 (je n’ai pas les adresses mails des assistantes mais les noms seront résolus par le carnet d’adresse outlook pour voir si le nom existe bien) pour les mettre dans le champ CC du message à envoyer

Je réussis pour l’instant à faire ce que je veux mais dans les champs du message, j’ai des doublons pour les responsables hiérarchiques et pour les assistantes.

Je suis autodidacte en vba et je suis bloqué sur le « comment insérer le contrôle des doublons et les écarter quand je construis ma liste de destinataire dans mon For Next »



Je suis ouvert à tous vos conseils qui pourraient me permettre de m’améliorer.

Je vous remercie par avance

 

[mapomme]

Bonjour @Mak_tarmak ,

Pour une liste sans doublon, pour SDest2, essayez :

   Dim mail As String, x
   SDest2 = ""
   For Each x In Intersect(ActiveSheet.UsedRange, ActiveSheet.Columns("e:e"))
      mail = Trim(x)
      If mail <> "" Then If InStr(1, SDest2, mail, vbTextCompare) = 0 Then SDest2 = SDest2 & ";" & mail
   Next x
   SDest2 = Mid(SDest2, 2)

A adapter pour SDest3.

 

[mapomme]

Re,
On peut faire les hiérarchiques et les assistantes en une seule boucle :

   Dim mail As String, x
   SDest2 = ""
   For Each x In Intersect(ActiveSheet.UsedRange, ActiveSheet.Range("e:e,f:f"))
      mail = Trim(x)
      If mail <> "" Then If InStr(1, SDest2, mail, vbTextCompare) = 0 Then SDest2 = SDest2 & ";" & mail
   Next x
   SDest2 = Mid(SDest2, 2)

Ce qui donnerait :

Sub Sample()
'Setting up the Excel variables.
Dim olApp As Object, olMailItm As Object
Dim mail As String, x, SDest As String, SDest2 As String

'Create the Outlook application and the empty email.
Set olApp = CreateObject("Outlook.Application")
Set olMailItm = olApp.CreateItem(0)

' déclaration des colonnes qui contiennent les mails
numCol1 = 3: numCol2 = 5: numCol3 = 6

'Using the email, add multiple recipients, using a list of addresses in column A or Other.
With olMailItm
  SDest = ""
   For Each x In Intersect(ActiveSheet.UsedRange, ActiveSheet.Columns(numCol1))
      mail = Trim(x)
      If mail <> "" Then If InStr(1, SDest, mail, vbTextCompare) = 0 Then SDest = SDest & ";" & mail
   Next x
   SDest = Mid(SDest, 2)
   
   SDest2 = ""
   For Each x In Intersect(ActiveSheet.UsedRange, Union(ActiveSheet.Columns(numCol2), ActiveSheet.Columns(numCol3)))
      mail = Trim(x)
      If mail <> "" Then If InStr(1, SDest2, mail, vbTextCompare) = 0 Then SDest2 = SDest2 & ";" & mail
   Next x
   SDest2 = Mid(SDest2, 2)
   .To = SDest
   .CC = SDest2
   .Subject = "For You"
   .Body = "Veuillez trouver ci-joint..."
   .display
End With

'Clean up the Outlook application.
Set olMailItm = Nothing: Set olApp = Nothing
End Sub

Remarque : je ne commente jamais mes codes à moins qu'on ne me le demande (gentiment ).

 

[Mak_tarmak]

Re,
On peut faire les hiérarchiques et les assistantes en une seule boucle :

   Dim mail As String, x
   SDest2 = ""
   For Each x In Intersect(ActiveSheet.UsedRange, ActiveSheet.Range("e:e,f:f"))
      mail = Trim(x)
      If mail <> "" Then If InStr(1, SDest2, mail, vbTextCompare) = 0 Then SDest2 = SDest2 & ";" & mail
   Next x
   SDest2 = Mid(SDest2, 2)

Ce qui donnerait :

Sub Sample()
'Setting up the Excel variables.
Dim olApp As Object, olMailItm As Object
Dim mail As String, x, SDest As String, SDest2 As String

'Create the Outlook application and the empty email.
Set olApp = CreateObject("Outlook.Application")
Set olMailItm = olApp.CreateItem(0)

' déclaration des colonnes qui contiennent les mails
numCol1 = 3: numCol2 = 5: numCol3 = 6

'Using the email, add multiple recipients, using a list of addresses in column A or Other.
With olMailItm
  SDest = ""
   For Each x In Intersect(ActiveSheet.UsedRange, ActiveSheet.Columns(numCol1))
      mail = Trim(x)
      If mail <> "" Then If InStr(1, SDest, mail, vbTextCompare) = 0 Then SDest = SDest & ";" & mail
   Next x
   SDest = Mid(SDest, 2)
  
   SDest2 = ""
   For Each x In Intersect(ActiveSheet.UsedRange, Union(ActiveSheet.Columns(numCol2), ActiveSheet.Columns(numCol3)))
      mail = Trim(x)
      If mail <> "" Then If InStr(1, SDest2, mail, vbTextCompare) = 0 Then SDest2 = SDest2 & ";" & mail
   Next x
   SDest2 = Mid(SDest2, 2)
   .To = SDest
   .CC = SDest2
   .Subject = "For You"
   .Body = "Veuillez trouver ci-joint..."
   .display
End With

'Clean up the Outlook application.
Set olMailItm = Nothing: Set olApp = Nothing
End Sub

Remarque : je ne commente jamais mes codes à moins qu'on ne me le demande (gentiment ).

Bonjour @mapomme,
Un grand merci !
J'ai testé avec les deux boucles et avec une seule tout marche nickel
Le code est très clair et quand je ne comprenais pas je suis parti sur internet chercher les méthodes que vous avez utilisé.
Il n'y a qu'une seule chose que je ne suis pas sûr d'avoir compris, même en faisant le pas à pas détaillé c'est le Mid(SDest2, 2). Je vois que cela retourne une chaîne de caractères et peut-être que le 2 qui suit correspond au ; séparateur ?

 

[mapomme]

Re,

Mid(SDest2, 2)

Une forme plus générale est Mid(SDest2,début ,nbcar) : on considère la chaine de caractères SDest2 et on renvoie nbcar caractères de la chaine à partir du caractère de rang début. Mid("abc,def,ghi",6;4) renvoie "ef,g"

• Si nbcar est omis, Mid renvoie jusqu'à la fin de la chaine de caractères : Mid("abc,def,ghi",6) renvoie "ef,ghi"
• Si nbcar est supérieur au nombre restant de caractères, Mid renvoie jusqu'à la fin de la chaine de caractères : Mid("abc,def,ghi",4,999) renvoie "ef,ghi"
• Si Début est supérieur au nombre de caractères de la chaine, Mid renvoie une chaine vide : Mid("abc,def,ghi",99;4) renvoie ""
• Si la chaine SDest2 est vide alors MID renvoie la chaine vide "" (début et nbcar sont quelconques)

Donc Mid(SDest2, 2) renvoie la chaine extraite de SDest2 à partir du 2ème caractère et jusqu'à la fin de la chaine.

Dans la macro, on va avoir deux cas :
Cas n°1 :
On a trouvé au moins une adresse mail donc SDest2 est de la forme ";nom@xxx.com..."
Il faut enlever ce point-virgule en position n° 1. Cela se fait par Mid(SDest2,2)

Cas n°2 :
On n'a trouvé aucune adresse donc SDest21 est la chaine vide.
Et Mid(SDest2,2) donne aussi la chaine vide.

Dans les deux cas, on aura ôté le ";" en première position (même s'il n'existe pas )

On aurait aussi pu écrire :
If Left(SDest2,1)= ";" then SDest2 = Mid(SDest2,2) mais c'est plus long à écrire...

 

[Mak_tarmak]

Re,

Mid(SDest2, 2)

Une forme plus générale est Mid(SDest2,début ,nbcar) : on considère la chaine de caractères SDest2 et on renvoie nbcar caractères de la chaine à partir du caractère de rang début. Mid("abc,def,ghi",6;4) renvoie "ef,g"

• Si nbcar est omis, Mid renvoie jusqu'à la fin de la chaine de caractères : Mid("abc,def,ghi",6) renvoie "ef,ghi"
• Si nbcar est supérieur au nombre restant de caractères, Mid renvoie jusqu'à la fin de la chaine de caractères : Mid("abc,def,ghi",999) renvoie "ef,ghi"
• Si Début est supérieur au nombre de caractères de la chaine, Mid renvoie une chaine vide : Mid("abc,def,ghi",99;4) renvoie ""
• Si la chaine SDest2 est vide alors MID renvoie la chaine vide "" (début et nbcar sont quelconques)

Donc Mid(SDest2, 2) renvoie la chaine extraite de SDest2 à partir du 2ème caractère.

Dans la macro, on va avoir deux cas :
Cas n°1 :
On a trouvé au moins une adresse mail donc SDest2 est de la forme ";nom@xxx.com..."
Il faut enlever ce point-virgule. Cela se fait par Mid(SDest2,2)

Cas n°2 :
On n'a trouvé aucune adresse donc SDest21 est la chaine vide.
Et Mid(SDest2,2) donne aussi la chaine vide.

Dans les deux cas, on aura ôter le ";" en première position (même s'il n'existe pas )

On aurait aussi pu écrire :
If Left(SDest2,1)= ";" then SDest2 = Mid(SDest2,2) mais c'est plus long à écrire...

Merci beaucoup @mapomme, c'est très très clair.