Mehrere Comboboxen mit Werten füllen

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
Bild

Betrifft: Mehrere Comboboxen mit Werten füllen
von: P-Quest :-)
Geschrieben am: 12.07.2015 15:08:49

Hallo,
ich möchte mehrere Comboboxen in einem Userform mit Daten aus unterschiedlichen Spalten einer Stammdatentabelle füllen. Hierbei sollen Duplikate verhindert werden und die Liste der Combobox alphabetisch sortiert sein.
Mit einer Combobox funktioniert das ganze sehr gut mit einem Code, den ich mir mit Hilfe div. Seiten im Netz zusammengeschnibbelt habe. Siehe unten!
Nun möchte ich diesen Code so verändern, dass ich ihn für alle 6 Comboboxen verwenden kann, ohne jedesmal den ganzen Code zu wiederholen. Ich dachte da an ein Schleife. Allerdings frage ich mich, wie ich die Namen der Comboboxen und die dazugehörigen Tabellenspalten in dieser Schleife unterbringe. Mein erster Gedanke ist, diese Informationen in einem Array abzulegen und dieses in einer Schleife abzuarbeiten. Ich weiss aber nicht, ob ich damit richtig liege. Wenn ja, weiss ich nicht, wie genau ich das bewerkstelligen muss.
Kann mir jemand dabei helfen?

Option Explicit
Private Sub UserForm_Initialize()
Dim ar As Variant
Dim dictUnikate As Object
Dim lngLastRow As Long
Dim ws As Worksheet
Set ws = Worksheets("Stammdaten")
Set dictUnikate = CreateObject("scripting.dictionary")
lngLastRow = ws.Cells(Rows.Count, 2).End(xlUp).Row
    ar = ws.Range(Cells(6, 2), Cells(lngLastRow, 2))
    ar = WorksheetFunction.Transpose(ar)
    Call Unikate(ar)
    Call QSort(ar, LBound(ar), UBound(ar))
       
    cbName.List = ar
       
End Sub
Sub Unikate(ByRef ar)
Dim i As Long
    With CreateObject("scripting.dictionary")
        For i = LBound(ar) To UBound(ar)
             If ar(i) <> "" Then .Item(ar(i)) = 0
        Next
        ar = .Keys
    End With
    
End Sub
Sub QSort(ByRef arr, low, hi)
Dim i, j, p
    While low < hi
        p = arr(hi)
        i = low - 1
        For j = low To hi - 1
            If arr(j) <= p Then
                i = i + 1
                Swap arr, i, j
            End If
        Next
        Swap arr, i + 1, j
        QSort arr, low, i
        low = i + 2
    Wend
    
End Sub
Sub Swap(ByRef arr, first, second)
Dim t
    t = arr(first)
    arr(first) = arr(second)
    arr(second) = t
    
End Sub
mfg,
P-Quest :-)

Bild

Betrifft: AW: Mehrere Comboboxen mit Werten füllen
von: Sepp
Geschrieben am: 12.07.2015 15:49:03
Hallo Peter,
vom Prinzip her so.

' **********************************************************************
' Modul: UserForm1 Typ: Userform
' **********************************************************************

Option Explicit

Private Sub UserForm_Initialize()
  Dim vntRef As Variant, vntI As Variant, vntSrc As Variant, vntList As Variant
  Dim lngI As Long
  
  vntRef = Array("A2:A10", "B2:B15", "C2:C10")
  
  For Each vntI In vntRef
    lngI = lngI + 1
    vntSrc = Sheets("Tabelle1").Range(vntI)
    vntList = toArraySorted(vntSrc)
    Me.Controls("ComboBox" & lngI).Object.List = vntList
  Next
  
End Sub



Private Function toArraySorted(Field As Variant, Optional Uniqe As Boolean = True) As Variant
  Dim objArrayList As Object
  Dim lngR As Long, lngC As Long
  
  On Error GoTo ErrExit
  
  Set objArrayList = CreateObject("System.Collections.Arraylist")
  
  With objArrayList
    For lngR = LBound(Field, 1) To UBound(Field, 1)
      For lngC = LBound(Field, 2) To UBound(Field, 2)
        If Not .Contains(Trim(Field(lngR, lngC))) Or Not Uniqe Then
          If Field(lngR, lngC) <> "" Then .Add Trim(Field(lngR, lngC))
        End If
      Next
    Next
    .Sort
    toArraySorted = .toArray
  End With
  
  Exit Function
  ErrExit:
  toArraySorted = -1
End Function


Gruß Sepp


Bild

Betrifft: AW: Mehrere Comboboxen mit Werten füllen
von: P-Quest :-)
Geschrieben am: 12.07.2015 16:39:13
Hallo Sepp,
danke erst mal für deinen Vorschlag.
Wie gehe ich aber vor, wenn die Comboboxen nicht nummeriert sind, sondern definierte Namen tragen wie cbLieferant, cbHersteller etc.
Irgendwie muss es doch die Möglichkeit geben, den Namen der Combobox mit dem korrespondierenden Zellbereich in Verbindung zu bringen.
mfg,
P-Quest :-)

Bild

Betrifft: AW: Mehrere Comboboxen mit Werten füllen
von: Sepp
Geschrieben am: 12.07.2015 16:59:58
Hallo Peter,

Private Sub UserForm_Initialize()
  Dim vntRef As Variant, vntI As Variant, vntSrc As Variant, vntList As Variant
  Dim vntCntrl As Variant
  Dim lngI As Long
  
  vntRef = Array("A2:A10", "B2:B15", "C2:C10")
  vntCntrl = Array("cbName", "cbLieferant", "cbHersteller")
  
  For lngI = 0 To UBound(vntRef)
    vntSrc = Sheets("Tabelle1").Range(vntI(lngI))
    vntList = toArraySorted(vntSrc)
    Me.Controls(vntCntrl(lngI)).Object.List = vntList
  Next
  
End Sub


Gruß Sepp


Bild

Betrifft: AW: Mehrere Comboboxen mit Werten füllen
von: P-Quest :-)
Geschrieben am: 12.07.2015 17:22:32
Hallo Sepp,
ich habe deinen Vorschlag für meinen bestehenden Code adaptiert und es hat wunderbar geklappt!
Vielen Dank,
Peter

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Mehrere Comboboxen mit Werten füllen"