Anzeige

VBA
Programmierer
gesucht?
 
Anzeige
VBA Programmierer gesucht?
 

VBA Codeschnipselsammlung

Voneinander abhängige ComboBoxen erstellen

Immer wieder gibt es in Foren die Frage: Wie erstellt man voneinander abhängige ComboBoxen? Aus diesem Grund habe ich ein kleines stark vereinfachtes Beispiel vorbereitet:

  A B C D E
 1  Kategorie 1 Kategorie 2 Kategorie 3 Weitere Spalten...           
 2  Gruppe 1 Gemüse Kartoffel    
 2  Gruppe 1 Gemüse Zwiebel    
 2  Gruppe 2 Kräuter Schnittlauch    
 2  Gruppe 3 Obst Apfel    
 2  Gruppe 3 Obst Birne    

Ziel ist es drei ComboBoxen (Namen im Code: ComboBox1, ComboBox2 und ComboBox3) abhängig voneinander zu befüllen.

Ein kleines Beispiel: In der ersten ComboBox wähle ich "Gruppe 1" aus.

Diese Auswahl soll zur Folge haben, dass ComboBox2 und ComboBox3 neu gefüllt werden. Allerdings sollen nur die Einträge zur "Gruppe 1" verwendet werden. Für "Gruppe 1" wäre das nur das "Gemüse" aus Spalte 2.

Für die ComboBox3 werden dann nur die Möglichkeiten bereitsgestellt, bei denen "Gruppe 1" sowie "Gemüse" vorkommt. In diesem Fall die "Kartoffel" und die "Zwiebel".

Zusatz: Es soll keine doppelten Einträge in den ComboBoxen geben!

Folgend ein Beispielquelltext für eine UserForm mit drei ComboBoxen und der dazugehörigen Tabelle1.

Option Explicit
' ************************************************************************************************
' Autor/en: http://www.online-vba.de - Marc Wershoven
' Verwendung der Quelltexte auf eigene Gefahr!
' Es gelten die Nutzungsbedingungen von www.online-vba.de!
' Original-Quelltext: www.online-vba.de/vba_abhcomboboxen.php
' ************************************************************************************************


Const lSTARTZEILE As Long = 2

Private Sub UserForm_Initialize()
     Call FillComboBox1
End Sub

Private Sub FillComboBox1()
     Call MWFillComboBoxFromTableColumn(Tabelle1, 1, ComboBox1)
     If ComboBox1.ListCount >= 1 Then ComboBox1.ListIndex = 0
End Sub

'Ereignisroutine, wenn sich ComboBox1 verändert -> ComboBox2 und 3 neu füllen
Private Sub ComboBox1_Change()
     ComboBox3.Clear
     ComboBox2.Clear
     If ComboBox1.ListIndex = -1 Then Exit Sub
     Call MWFillComboBoxFromTableColumn(Tabelle1, 2, ComboBox2, 1, ComboBox1.Text)
     If ComboBox2.ListCount >= 1 Then ComboBox2.ListIndex = 0
End Sub

'Ereignisroutine, wenn sich ComboBox2 verändert -> ComboBox3 neu füllen
Private Sub ComboBox2_Change()
     ComboBox3.Clear
     If ComboBox2.ListIndex = -1 Then Exit Sub
     Call MWFillComboBoxFromTableColumn(Tabelle1, 3, ComboBox3, 1, ComboBox1.Text, 2, ComboBox2.Text)
     If ComboBox3.ListCount >= 1 Then ComboBox3.ListIndex = 0
End Sub

Private Sub MWFillComboBoxFromTableColumn(ByRef oSheet As Object, _
                 ByVal lColumn As Long, ByRef oComboBox As Object, _
                 Optional ByVal lColBedingung1 As Long = 0, Optional ByVal sBedingung1 As String = "", _
                 Optional ByVal lColBedingung2 As Long = 0, Optional ByVal sBedingung2 As String = "")
   Dim z As Long
   Dim zMax As Long
   Dim bFlag As Boolean
    
     oComboBox.Clear
     zMax = oSheet.UsedRange.Row + oSheet.UsedRange.Rows.Count - 1
    
     For z = lSTARTZEILE To zMax
         If Trim(CStr(oSheet.Cells(z, lColumn).Value)) <> "" Then
             bFlag = True
            
             If lColBedingung1 <> 0 Then
                 If LCase(Trim(CStr(oSheet.Cells(z, lColBedingung1)))) <> LCase(Trim(sBedingung1)) Then
                     bFlag = False
                 End If
             End If
            
             If lColBedingung2 <> 0 Then
                 If LCase(Trim(CStr(oSheet.Cells(z, lColBedingung2)))) <> LCase(Trim(sBedingung2)) Then
                     bFlag = False
                 End If
             End If
            
             If bFlag = True Then
                 Call MWFillNonDuplicatesToComboBox(oComboBox, oSheet.Cells(z, lColumn).Value)
             End If
         End If
     Next z
End Sub

Private Sub MWFillNonDuplicatesToComboBox(ByRef oComboBox As Object, ByVal sAddText As String)
   Dim i As Long
   Dim bFlag As Boolean
    
     If oComboBox.ListCount = 0 Then
         oComboBox.AddItem sAddText
     Else
         bFlag = False
        
         For i = 0 To oComboBox.ListCount - 1
             If LCase(Trim(CStr(oComboBox.List(i)))) = LCase(Trim(CStr(sAddText))) Then
                 bFlag = True
                 Exit For
             End If
         Next i
        
         If bFlag = False Then
             oComboBox.AddItem sAddText
         End If
     End If
End Sub


Autor: Marc Wershoven (2014)

Anzeige

VBA Programmierer gesucht?
http://www.WershovenOnline.de

Anzeige

Der Quick E-Mail Support von WershovenOnline®

Schnelle Hilfe bei Fragen rund um Microsoft® Office und VBA Makros

Der Quick E-Mail Support von WershovenOnline® Sie haben beispielsweise eine Frage zu einer Ihrer eigenen Makroprogrammierungen in VBA? Oder Sie suchen Unterstützung und Informationen über eine bestimmte Microsoft® Excel® Formel? Bei nahezu allen Fragen und Problemen rund um Microsoft® Office und VBA Makros steht Ihnen unser individueller Quick E-Mail Support zur Verfügung. Einfach, schnell und unkompliziert Ihre Frage in einer E-Mail formulieren, mit oder ohne Screenshots oder einer Beispieldatei absenden und kurze Zeit später haben Sie eine vollständige Lösung inkl. ausführlicher Erklärung vom Profi in Ihrem Postfach! Zusätzlich besteht die Option, dass wir uns mittels Fernwartung (selbstverständlich nach Ihrem Einvertändnis) direkt "live" mit Ihnen zusammen an Ihrem Bildschirm gemeinsam Fragen und Problemstellungen anschauen und lösen können!

Weitere Informationen zu diesem kostenpflichtigen Angebot finden Sie auf der Anbieterseite von WershovenOnline® auf www.wershovenonline.de.

Zum Anbieter des Quick-E-Mail-Support...

Zum Seitenanfang