VBA-Beispiel 147
mail schreiben
mail schreiben

ComboBox ohne doppelte Werte

Alle Werte einer Spalte sollen ohne Doppelte und alphabetisch sortiert in einer ComboBox angezeigt werden.
Public Sub Fill_ComboBox()  
Dim wksQ As Worksheet, wksTmp As Worksheet  
Dim rngData As Range   
Dim varData As Variant   
Dim ole As OLEObject   
Const strName As String = "myCombo"   

'+ -----------------------------------------------------------------------
'  alle Werte aus Spalte E (Städte) alphabetisch sortiert
'  und ohne doppelte in ComboBox packen
'+ -----------------------------------------------------------------------

  Set wksQ = ThisWorkbook.Worksheets("Tabelle1") 
  Set wksTmp = Application.Workbooks.Add.ActiveSheet 
  
  With wksQ 
    'Datenbereich festlegen
    Set rngData = .Range(.Range("E1"), .Range("E" & .Rows.Count).End(xlUp))   
    
    'vom Datenbereich nur einmalige Werte zu temporären Bereich kopieren
    rngData.AdvancedFilter Action:=xlFilterCopy, _
                           CopyToRange:=wksTmp.Range("A1"), _  
                           Unique:=True 
    'sortieren
    With wksTmp.Sort 
      .SortFields.Add Key:=Range("A2"), _ 
                      SortOn:=xlSortOnValues, _ 
                      Order:=xlAscending, _  
                      DataOption:=xlSortNormal
      
      .SetRange Range("A2:A" & Rows.Count)  
      '.Header = xlNo
      .Apply
    End With  
    
    'sortierte Daten zwischenspeichern
    varData = wksTmp.Range(wksTmp.Range("A2"), _ 
                           wksTmp.Range("A" & .Rows.Count).End(xlUp)).Value  
    
    'Tmp-Datei entsorgen
    wksTmp.Parent.Close SaveChanges:=False  
  End With  
      
  'in Tabelle schreiben:
  'Range("K1:K" & UBound(varData)) = varData

  'check ob Combo schon existiert
  For Each ole In wksQ.OLEObjects    

    If TypeName(ole.Object) = "ComboBox" And ole.Name = strName Then    
      Set ole = ole 
      
      MsgBox "Das Control """ & ole.Name & """ wird neu befüllt!", _
             vbInformation, "Hinweis!" 
      Exit For  
    End If  

  Next ole 
  
  'Control einfügen falls nicht vorhanden
  If ole Is Nothing Then     
    Set ole = wksQ.OLEObjects.Add(ClassType:="Forms.ComboBox.1", _   
                                  Link:=False, _ 
                                  Left:=330, _
                                  Top:=20, _ 
                                  Width:=80, _
                                  Height:=20)
    ole.Name = strName
    'ole.LinkedCell = Range("H5").Address 
  End If  
    
  With ole.Object  
    '.Clear
    .List = varData  'Werte eintragen
    .ListIndex = 0 
    .ListRows = 30
  End With  

  Erase varData  'Fehler falls String!
  Set ole = Nothing   
  Set rngData = Nothing   
  Set wksTmp = Nothing   
  Set wksQ = Nothing   
End Sub  

Download:   vba147.zip