Die Vorgabe von Inhalten für abhängige Kombinationsfelder kann, wie man vor allem an meinem zweiten Beipiel erkennen kann, sehr aufwändig werden. Oft kommt es vor, dass die Inhalte einfach aus der Liste kommen sollen, mit der ohnehin gearbeitet wird. Dabei wäre es von Vorteil, wenn sich die Listeninhalte der Kombinationsfelder automatisch an die sich verändernde Liste anpassen.
Auch für diesen Zweck habe ich ein UserForm mit drei Kombinationsfeldern vorgesehen. Somit ließe sich das auch mit dem UserForm aus dem Beispiel 2 realisieren. Dort müssten dann aber noch drei Bezeichnungsfelder angelegt werden, damit kein Fehler ausgelöst wird.
Für diese Vorgehensweise sind andere Makros erforderlich:
Option Explicit
Dim iZiel As Integer ' Letzte gefüllte Zelle
Dim i As Integer ' Schleifenzähler (Arrays füllen)
Dim az As Integer ' Zähler für Arrayfelder
Dim arr() As Variant ' Array für Datenausgabe
Dim arr1() As Variant ' Array für Datenausgabe
Dim arr2() As Variant ' Array für Datenausgabe
Private Sub UserForm_Activate()
' schreibt aus einer Liste, die nicht sortiert sein muss, alle vorkommenden
' Begriffe in eine ComboBox. Duplikate werden dabei ausgefiltert.
' Geschrieben von Klaus-Dieter Oppermann, Oktober 2005
' Variablen deklarieren
Dim vTitel As Variant
Dim iTit As Integer
vTitel = Range("A1:D1").Value
iZiel = Range("C65536").End(xlUp).Row ' Letzte gefüllte Zelle ermitteln (in Spalte C)
' Array dimensionieren
ReDim arr(iZiel, 0) ' Feld nach Listenlänge festlegen
' Arrays mit Werten füllen
For i = 2 To UBound(arr) ' laufe von Zeile 2 bis Tabellenende
If Application.WorksheetFunction.CountIf(Range(Cells(i, 1), _
Cells(1, 1)), Cells(i, 1).Value) = 1 Then ' wenn Wert das erste Mal vorkommt, dann ...
arr(az, 0) = Cells(i, 1).Value ' ... Name in Array einlesen
az = az + 1 ' ... Zähler für Arrayfeld plus 1
End If ' Ende der Auswertung
Next i ' Schleifenzähler plus 1
' Inhalte ausgeben
ComboBox1.List = arr ' Werte in ComboBox schreiben
For iTit = 1 To 3
Controls("Label" & iTit) = vTitel(1, iTit)
Next iTit
End Sub
Private Sub ComboBox1_Change()
Dim lZeile As Long
az = 0
ReDim arr1(iZiel, 0) ' Feld nach Listenlänge festlegen
ComboBox2.Clear
For i = 2 To UBound(arr) ' laufe von Zeile 2 bis Tabellenende
If Cells(i, 1) = ComboBox1.Text Then
If Application.WorksheetFunction.CountIf(Range(Cells(i, 2), _
Cells(1, 2)), Cells(i, 2).Value) = 1 Then ' wenn Wert das erste Mal vorkommt, dann ...
arr1(az, 0) = Cells(i, 2).Value ' ... Name in Array einlesen
az = az + 1 ' ... Zähler für Arrayfeld plus 1
End If ' Ende der Auswertung
End If
Next i ' Schleifenzähler plus 1
' Inhalte ausgeben
ComboBox2.List = arr1 ' Werte in ComboBox schreiben
End Sub
Private Sub ComboBox2_Change()
Dim lZeile As Long
az = 0
ReDim arr2(iZiel, 0) ' Feld nach Listenlänge festlegen
ComboBox3.Clear
For i = 2 To UBound(arr) ' laufe von Zeile 2 bis Tabellenende
If Cells(i, 2) = ComboBox2.Text Then
If Application.WorksheetFunction.CountIf(Range(Cells(i, 3), _
Cells(1, 3)), Cells(i, 3).Value) = 1 Then ' wenn Wert das erste Mal vorkommt, dann ...
arr2(az, 0) = Cells(i, 3).Value ' ... Name in Array einlesen
az = az + 1 ' ... Zähler für Arrayfeld plus 1
End If ' Ende der Auswertung
End If
Next i ' Schleifenzähler plus 1
' Inhalte ausgeben
ComboBox3.List = arr2 ' Werte in ComboBox schreiben
End Sub
Code eingefügt mit: Excel Code Jeanie |
Die Makros können leicht an andere Listen angepasst werden. Die Inhalte können aus beliebigen Spalten entnommen werden. Wobei jeder vorkommende Begriff nur einmal im Kombinationsfeld gelistet wird.
Eine Datei mit den Beispielen stelle ich im Bereich Beispieltabellen zur Verfügung.