Copier valeurs uniques d'un range

[Bernard]

Salut à tous,
j'essaie d'extraire les valeurs unique inclues dans Feuil1 A2:A20, afin de les copier dans Feuil2 F2, et de séparer ces valeurs par un "-", vous vous en doutez...j'y arrive pas:-(

En fait, Feuil2 F2 est la cellule qui me donne mon .Subject pour un e-mail, et Feuil2 contient aussi toutes les infos permanentes pour ce même e-mail
Donc si vous avez une soluce pour capturer les uniques de Feuil1 A2:A20 et les mettre comme .Subject, je prends aussi ;-))

Auriez-vous une formule miracle?
bernard

 

[@+Thierry]

Bonjour Bernard

Je te propose une procédure VBA...

Option Explicit

Sub UniqueCollection()
Dim TheUnic As Collection
Dim Item As Variant
Dim i As Byte
Dim TheString As String
Set TheUnic = New Collection

For i = 2 To 20
On Error Resume Next
TheUnic.Add Feuil1.Cells(i, 1).Text, Cells(i, 1).Text
Next

For Each Item In TheUnic
TheString = TheString & Item & "-"
Next

Feuil2.Range("F2") = Left(TheString, Len(TheString) - 1)
End Sub

Pour le Subject de Mail, il faudrait savoir quelle méthode tu utilises pour envoyer ton mail...

Bon Aprèm
@+Thierry

 

[@+Thierry]

Rectification

Remplacer :
TheUnic.Add Feuil1.Cells(i, 1).Text, Cells(i, 1).Text

par:
With Feuil1
TheUnic.Add .Cells(i, 1).Text, .Cells(i, 1).Text
End With

Sorry
@+Thierry

 

[Bernard]

Salut @Thierry, Re le Forum,

MERCI, trop fort! C'est tout simplement parfait!

Pour info, un extrait de la méthode sendmail, placé après tous les tests de vérifications d'existence des valeurs ou feuilles à envoyer, et des déclarations:

ThisWorkbook.Sheets(Arr).Copy
Set wb = ActiveWorkbook
With wb
.SaveAs "Extra-Samples " & ThisWorkbook.Sheets("mail").Cells(2, a + 5).Value & " " & strdate & ".xls"

Set olMail = olApp.CreateItem(olMailItem)
With olMail
.To = strto1
.CC = strto2
.BCC = strto3
.Subject = ThisWorkbook.Sheets("mail").Cells(2, a + 5).Value & "Extra-Samples "
.Body = strbody
.Attachments.Add wb.FullName
'.Send 'Or
.Display
End With
.ChangeFileAccess xlReadOnly
'Kill .FullName
.Close False
End With

"mail" est Feuil2

merci encore!!
bernard

 

[@+Thierry]

Bonsoir Bernard, le Forum

Par conséquent si tu déclares "TheString" publiquement (en top d'un Module Standard à la place d'être à l'intérieur de la Sub UniqueCollection...)
Public TheString As String

Pour faire plus propre tu dois la formater avant la sortie de la Sub UniqueCollection en remplaçant :
Feuil2.Range("F2") = Left(TheString, Len(TheString) - 1)

Par :
TheString = Left(TheString, Len(TheString) - 1)


Ensuite tu pourras l'utiliser directement dans ta procédure de mail ci-dessus sans passer par la Feuil2...
.Subject = TheString & " Extra-Samples"

Idem pour
.SaveAs "Extra-Samples " & TheString & " " & strdate & ".xls"
(ne sachant pas ce qu'est strdate)

Bonne soirée
@+Thierry

 

[bernard]

Merci @+Thierry pour ces détails supplémentaires!
Comme j'ai beaucoup d'infos dans Feuil2 qui font fonctionner mon sendmail comme je le veux, et qu'en plus ta solution fonctionne à merveille, je vais en rester là!
Mais j'ai pris note et logué l'alternative ci-dessus 🙂

A...plus
bernard

 

[bernard]

Ah, et strdate, as String
strdate = Format(Now, "dd-mm-yy h-mm-ss")

voili-voilou
bon weekend à tous, sous le soleil et barbecue à fond!!

bernard