PDA

Vollständige Version anzeigen : Nur sichtbare ohne Duplikate (F5)


kurze Frage
03.07.2014, 10:12
Hallo zusammen,

ich brauchte eine flexible Lösung, um Mails an bestimmte Empfänger zu schicken, darum hab ich das gebaut: In einer fortlaufenden Excel-Tabelle werden die Empfänger mit Grund eingetragen, dann wird der Bereich (eine Spalte mit Mailadressen) von Hand markiert und per Button so ausgeführt:

Sub Email()
Dim objOL As Object
Dim objMail As Object
Dim c As Range, tmp As String

Set objOL = CreateObject("Outlook.Application")
Set objMail = objOL.CreateItem(0)

For Each c In Selection.SpecialCells(xlCellTypeVisible)
tmp = tmp & c & ";"
Next
tmp = Left(tmp, Len(tmp) - 1)
[r1] = tmp


With objMail
.To = Range("R1").Value
.Subject = " Bitte Paket abholen "
....
'gekürzt
End Sub


mit For Each c In Selection.SpecialCells(xlCellTypeVisible)
markiere ich nur die sichtbaren (wie mit F5, Inhalte), nicht die ausgefilterten, die sonst dabei gewesen wären.

Da aber eine Person mehrere Pakete bekommen kann, ist der Empfänger immer sooft im an, wie er in der Tabelle vorkommt.

Kann ich "nur sichtbare" mit "ohne Duplikate" kombinieren, so dass jeder nur einmal auftaucht?

Danke!

Mc Santa
03.07.2014, 10:45
Hallo,

ich würde es etwa so machen:


'[...]
Dim tmp as String
For Each c In Selection.SpecialCells(xlCellTypeVisible)
If not InStr(1, tmp, c.value) > 0 Then tmp = tmp & c.value & ";"
Next
tmp = Left(tmp, Len(tmp) - 1)
Range("R1") = tmp
'[...]


Hilft dir das weiter?
VG

kurze Frage
03.07.2014, 13:20
Hallo Santa,

leider bringt es nicht den gewünschten Erfolg, es werden keine doppelten ausgeschlossen - wer 4x in der Liste steht, steht auch 4x im "An" der Mail.

Trotzdem danke für den schnellen Versuch!

VG
Claudia

R J
03.07.2014, 13:27
...wie wäre es, mit der Funktion Duplikate entfernen aus dem Menü Daten?
aber Vorsicht! Vorher eine Sicherung anlegen, denn die Duplikate sind dann wirklich weg...:)

Mc Santa
03.07.2014, 13:38
Hallo,

ich habe es soeben noch einmal probiert und bei mir funktioniert es:
Sub Email()
Dim objOL As Object
Dim objMail As Object
Dim c As Range, tmp As String

Set objOL = CreateObject("Outlook.Application")
Set objMail = objOL.CreateItem(0)

For Each c In Selection.SpecialCells(xlCellTypeVisible)
If Not InStr(1, tmp, c.Value) > 0 Then tmp = tmp & c.Value & ";"
Next
tmp = Left(tmp, Len(tmp) - 1)
Range("R1") = tmp

With objMail
.To = Range("R1").Value
.Subject = " Bitte Paket abholen "
.display
End With
'gekürzt
End Sub

Falls du Schwierigkeiten mit dem Code hast, dann lade bitte eine Beispieldatei mit dem Fehler hoch.

VG

kurze Frage
03.07.2014, 14:06
komische Sache... ich hab jetzt die gleiche Zeile wie vorhin nochmal eingefügt und es geht... alles wie es oll.

Danke!!