Der erste Zeil - keine Duplikate:
Sub Dropdown_Box()
'Erstelle eine neue Dropdown-Box
Dim dropdown As Object
Set dropdown = ActiveSheet.DropDowns.Add(200, 200, 150, 20)
'Erstelle eine Liste aller markierten Elemente
Dim selectedList As Range
Set selectedList = ActiveSheet.Range("A1:Z1000").SpecialCells(xlCellTypeConstants)
'Entferne Duplikate aus der Liste
Dim uniqueList As Collection
Set uniqueList = New Collection
For Each cell In selectedList
On Error Resume Next
uniqueList.Add cell.Value, CStr(cell.Value)
On Error GoTo 0
Next cell
'Füge die eindeutige Liste der Dropdown-Box hinzu
For i = 1 To uniqueList.Count
dropdown.AddItem uniqueList(i)
Next i
End Sub
|