Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Anzeige
Inhaltsverzeichnis

Emailadressen zusammenfassen ohne Meherfachnennungen

Forumthread: Emailadressen zusammenfassen ohne Meherfachnennungen

Emailadressen zusammenfassen ohne Meherfachnennungen
21.06.2025 17:36:27
Manasse
Hallo,
ich habe eine Zeile mit Email Adressen gefüllt, die ich in einem Feld mit dem Zeichen „; “ getrennt zusammenfassen möchte. Schwierigkeit dabei ist, dass in der Zeile Adressen mehrfach auftauchen, die in der Zusammenfassung nur einmal erscheinen sollen. In dem beigefügten Beispiel habe ich versucht das ganze darzustellen.

Hat jemand eine Idee wie das zu lösen ist? Ich bin für jeden Vorschlag echt dankbar!!

Gruß Manasse


https://www.herber.de/bbs/user/177815.xlsx
Anzeige

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Emailadressen zusammenfassen ohne Meherfachnennungen
21.06.2025 18:19:52
xlKing
Hallo Manasse,

enthält dein Excel 2013 schon die Funktion "Duplikate entfernen"? Dann ließe sich das besonders schnell und ohne Schleife über folgendes Makro lösen:

Sub Zusammenfassen()


arr1 = Application.Transpose(Sheets("Tabelle1").Range("B3:I3"))

'Duplikate entfernen
With Sheets("Tabelle2").Range("A1").Resize(UBound(arr1, 1), 1)
.Value = arr1
.RemoveDuplicates Columns:=1, Header:=xlNo
lastrow = Sheets("Tabelle2").Cells(Rows.Count, 1).End(xlUp).Row
arr2 = Application.Transpose(.Resize(lastrow, 1))
End With

'Ausgabe
Sheets("Tabelle1").Range("B10").Value = Join(arr2, "; ")

End Sub


Gruß Mr. K.
Anzeige
AW: Emailadressen zusammenfassen ohne Meherfachnennungen
21.06.2025 18:47:47
Blaukraut05
He,
so sollte es funktionieren

Sub FasseEinzigartigeEmailsZusammen()
Dim rng As Range
Dim cell As Range
Dim email As String
Dim dict As Object
Dim result As String

Set rng = Range("B3:I3")

Set dict = CreateObject("Scripting.Dictionary")

For Each cell In rng
If Not IsEmpty(cell.Value) Then
email = Trim(cell.Value)
If Len(email) > 0 Then
If Not dict.exists(email) Then
dict.Add email, 1
End If
End If
End If
Next cell

result = Join(dict.keys, "; ")

Range("B10").Value = result
End Sub


Viele Grüße
Michael
Anzeige
Außer Konkurrenz
21.06.2025 18:52:45
RPP63
Moin!
Nutze ein aktuelles Excel (auch Excel-Online, Google Sheets oder Libre Office Calc funktionieren, nur Deine Gruftie-Version nicht).
Excel:
=TEXTVERKETTEN("; ";;EINDEUTIG(MTRANS(B3:I3)))

Google Sheets:
=TEXTJOIN("; ";;UNIQUE(B3:I3;1))

Calc:
=VERBINDEN("; ";;EINZIGARTIG(B3:I3;1))


Gruß Ralf
Anzeige
AW: Emailadressen zusammenfassen ohne Meherfachnennungen
22.06.2025 00:37:02
Daniel
Hi

Un deiner Execelversion mit dieser Formel in B4:
=WENN(ISTZAHL(FINDEN(B3;C4));C4;B3&WENN(C4="";"";"; "&C4))


Die Formel soweit nach rechts ziehen wie es Mailadressen gibt.
Das Ergebnis steht in B4.

Gruß Daniel
AW: Emailadressen zusammenfassen ohne Meherfachnennungen
23.06.2025 00:08:20
Manasse
Hallo an alle Helfer,

euch allen ganz herzlichen Dank für eure Inputs. Ich habe das für mich passenste herausgesucht und getestet. Es klappt alles prima!!

Gruß Manasse
Anzeige
AW: Außer Konkurrenz, kleine Korrektur
21.06.2025 18:56:27
RPP63
Auch Excel kennt natürlich bei Eindeutig das Argument nach Spalten.
Daher analog zur "Konkurrenz":
=TEXTVERKETTEN("; ";;EINDEUTIG(B3:I3;1))
Anzeige
Anzeige
Live-Forum - Die aktuellen Beiträge
Datum
Titel
14.05.2026 13:31:09
14.05.2026 09:50:42
13.05.2026 19:14:18