gleiche Zelleninhalte zusammenfassen und für Combo

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Public Sub Vereinzeln() Dim lZeile As Long Dim vTemp As Variant Dim iTemp As Integer Dim sTrennzeichen As String Dim myDict As Object Dim sName As String Set myDict = CreateObject("Scripting.Dictionary") sTrennzeichen = "," ' das Trennzeichen der Namen in den Zellen With ThisWorkbook.Worksheets("Tabelle1") ' den Tabellenblattnamen ggf. anpassen! For lZeile = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row If Trim$(.Range("A" & lZeile).Value) "" Then vTemp = Split(.Range("A" & lZeile).Value, sTrennzeichen) For iTemp = LBound(vTemp) To UBound(vTemp) sName = Trim$(vTemp(iTemp)) myDict(sName) = sName Next iTemp End If Next lZeile End With If myDict.Count > 0 Then ' die Unikate in der ComboBox ablegen UserForm1.ComboBox1.List = myDict.Keys ThisWorkbook.Worksheets("Tabelle1").ComboBox1.List = myDict.Keys End If End Sub

Hallo Christian,
hier noch die Ausgabe der Namen in Spalte C ab Zeile 2

Option Explicit
'   Ich habe bspw. 10 Zellen untereinander, die gefüllt sind mit Name1, Name2, Name3, Name1,  _
Name4, Name2 etc.
'   Ich möchte gern die gleichen Namen gruppieren, also in neuen Zellen eine Zusammenfassung  _
der Namen haben.
'   Diese Zellen sollen dann in einer ComboBox angesteuert werden, so dass man die Namen nicht  _
doppelt in der ComboBox hat.
Public Sub Vereinzeln()
Dim lZeile         As Long
Dim vTemp          As Variant
Dim iTemp          As Integer
Dim sTrennzeichen  As String
Dim myDict         As Object
Dim sName          As String
Set myDict = CreateObject("Scripting.Dictionary")
sTrennzeichen = "," ' das Trennzeichen der Namen in den Zellen
With ThisWorkbook.Worksheets("Tabelle1") ' den Tabellenblattnamen ggf. anpassen!
For lZeile = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
If Trim$(.Range("A" & lZeile).Value)  "" Then
vTemp = Split(.Range("A" & lZeile).Value, sTrennzeichen)
For iTemp = LBound(vTemp) To UBound(vTemp)
If Trim$(vTemp(iTemp))  "" Then sName = Trim$(vTemp(iTemp))
myDict(sName) = sName
Next iTemp
End If
Next lZeile
If myDict.Count > 0 Then
'        die Unikate in der ComboBox ablegen
UserForm1.ComboBox1.List = myDict.keys
ThisWorkbook.Worksheets("Tabelle1").ComboBox1.List = myDict.keys
.Range("C2").Resize(myDict.Count) = Application.Transpose(myDict.keys)
End If
End With
End Sub

Gruß Peter

Beliebteste Forumthreads (12 Monate)

gleiche Zelleninhalte zusammenfassen und für Combo

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

304 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

gleiche Zelleninhalte zusammenfassen und für Combo

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

304 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread