VBA Formular mit Unterpunkten

[holybego]

Hallo,

ich versuche aktuell ein Eingabeformular in VBA zu bauen. Jetzt hab ich immer Comboboxen benutzt
und auf einer extra Tabelle praktisch die anzuwählenden Punkte hinterlegt. 

Nun ist aber der Fall eingetreten, dass es Unterpunkte geben soll. Also den Punkt in der Combobox ausgewählt,
sollte sich eine neue Unterteilung öffnen.


Wert 1 ---> Unterwert 1, Unterwert 2, Unterwert 3
Wert 2 ---> Unterwert 1 usw...

Wie kann sich hier eine Lösung gestalten ?

[Warkings]

Auch hier habe ich einfach ChatGPT gefragt und die Antwort funtkioniert, d.h. ich habe sie 1:1 getestet.

Um eine hierarchische Auswahl in einem VBA-Formular mit ComboBoxen in Excel zu implementieren, können Sie mit einer Abhängigkeitslogik arbeiten. Das bedeutet, dass die zweite ComboBox (für die Unterwerte) abhängig von der Auswahl in der ersten ComboBox (für die Hauptwerte) gefüllt wird. Hier ist eine schrittweise Anleitung, wie Sie dies umsetzen können:
1. Datenerstellung und Struktur
Erstellen Sie eine Tabelle auf einem Arbeitsblatt, die die Hauptwerte und die dazugehörigen Unterwerte enthält. Zum Beispiel:
Hauptwert Unterwert
Wert 1 Unterwert 1
Wert 1 Unterwert 2
Wert 1 Unterwert 3
Wert 2 Unterwert 1
Wert 2 Unterwert 2
Wert 3 Unterwert 1
Wert 3 Unterwert 2
Speichern Sie diese Tabelle z.B. in einem Arbeitsblatt namens „Daten“.
2. Formular erstellen
Erstellen Sie ein VBA-Formular mit zwei ComboBoxen. Zum Beispiel

Code:

ComboBox1

für die Hauptwerte und

Code:

ComboBox2

für die Unterwerte.
3. VBA-Code zum Füllen der ComboBoxen
Fügen Sie den folgenden VBA-Code in das Formular ein:
vba
Code kopieren

Code:

Private Sub UserForm_Initialize()
    Dim ws As Worksheet
    Dim rng As Range
    Dim cell As Range
    Dim dict As Object
   
    ' Set worksheet and range
    Set ws = ThisWorkbook.Sheets("Daten")
    Set rng = ws.Range("A2", ws.Cells(ws.Rows.Count, "A").End(xlUp))
   
    ' Create dictionary to store unique main values
    Set dict = CreateObject("Scripting.Dictionary")
   
    ' Populate ComboBox1 with unique main values
    For Each cell In rng
        If Not dict.exists(cell.Value) Then
            dict.Add cell.Value, Nothing
            ComboBox1.AddItem cell.Value
        End If
    Next cell
End Sub
Private Sub ComboBox1_Change()
    Dim ws As Worksheet
    Dim rng As Range
    Dim cell As Range
    Dim selectedMainValue As String
   
    ' Set worksheet
    Set ws = ThisWorkbook.Sheets("Daten")
   
    ' Clear ComboBox2 items
    ComboBox2.Clear
   
    ' Get selected main value
    selectedMainValue = ComboBox1.Value
   
    ' Populate ComboBox2 based on selected main value
    Set rng = ws.Range("A2", ws.Cells(ws.Rows.Count, "A").End(xlUp))
    For Each cell In rng
        If cell.Value = selectedMainValue Then
            ComboBox2.AddItem cell.Offset(0, 1).Value
        End If
    Next cell
End Sub

Erklärung des Codes:

1. UserForm_Initialize:
   • Dieser Code wird ausgeführt, wenn das Formular initialisiert wird.
     
   • Es werden alle eindeutigen Hauptwerte aus der Tabelle „Daten“ gelesen und in
     
     Code:

     ComboBox1
     eingefügt.
     
2. ComboBox1_Change:
   • Dieser Code wird ausgeführt, wenn sich die Auswahl in
     
     Code:

     ComboBox1
     ändert.
     
   • Code:

     ComboBox2
     wird geleert und dann basierend auf dem ausgewählten Hauptwert mit den entsprechenden Unterwerten gefüllt.
     

Schritt-für-Schritt-Vorgehen:

1. Tabellenblatt „Daten“ erstellen:
   • Erstellen Sie ein Tabellenblatt namens „Daten“ und fügen Sie dort die Tabelle mit den Hauptwerten und Unterwerten ein, wie oben beschrieben.
     
2. VBA-Formular erstellen:
   • Öffnen Sie den VBA-Editor (Alt + F11).
     
   • Fügen Sie ein neues UserForm hinzu (Einfügen > UserForm).
     
   • Fügen Sie zwei ComboBoxen hinzu und benennen Sie sie
     
     Code:

     ComboBox1
     und
     
     Code:

     ComboBox2
     .
     
3. VBA-Code einfügen:
   • Doppelklicken Sie auf das UserForm, um das Code-Fenster zu öffnen.
     
   • Fügen Sie den oben bereitgestellten VBA-Code ein.
     
4. Formular testen:
   • Schließen Sie den VBA-Editor und führen Sie das Formular aus (F5 oder über ein zugeordnetes Makro).
     

Mit dieser Lösung haben Sie ein dynamisches Dropdown-Menü, das je nach Auswahl im ersten Dropdown (ComboBox1) die entsprechenden Unterwerte im zweiten Dropdown (ComboBox2) anzeigt. Falls Sie weitere Anpassungen benötigen, lassen Sie es mich wissen!

[holybego]

Code:

Option Explicit

Private P_BewohnerID As Long


Private P_Tabellenzeile As Long



Public Property Let BewohnerID(neuBewohnerID As Long)

  P_BewohnerID = neuBewohnerID
   

End Property



Private Sub btnSchließen_Click()

Unload Me

End Sub

Private Function Prüfung() As Boolean

'Standardwert definieren
Prüfung = True


'Datenprüfung einfügen
If txtVorname.Value = "" Or txtNachname.Value = "" Or txtGeburtsdatum.Value = "" Or cbWohnhaus.Value = "" Or cbWohngruppe.Value = "" Then

    'Benutzer benachrichtigen
    MsgBox "Bitte füllen Sie alle Felder aus.", , "Benjamin Heilig"
   
    'rückgabewert definieren
    Prüfung = False


End If






End Function


Private Sub btnSpeichern_Click()


'Prüfung
If Prüfung = False Then Exit Sub



'Blattschutz deaktivierenUSerform
B_Bewohner.Unprotect

'Anlegen oder Bearbeiten? Anlegen

If P_BewohnerID = 0 Then



'Neue Tabellenzeile hinzufügen
With B_Bewohner.ListObjects("tblBewohner").ListRows.Add

    'neue Tabellenzeile befüllen
    .Range(, 1).Value = txtBewohnerID.Value
    .Range(, 2).Value = txtVorname.Value
    .Range(, 3).Value = txtNachname.Value
    .Range(, 4).Value = txtGeburtsdatum.Value
    .Range(, 5).Value = cbWohnhaus.Value
    .Range(, 6).Value = cbWohngruppe.Value

   

End With

'Bearbeiten
Else

With B_Bewohner.ListObjects("tblBewohner")

    'Datenbankzeile befüllen
    .DataBodyRange(P_Tabellenzeile, 2).Value = txtVorname.Value
    .DataBodyRange(P_Tabellenzeile, 3).Value = txtNachname.Value
    .DataBodyRange(P_Tabellenzeile, 4).Value = txtGeburtsdatum.Value
    .DataBodyRange(P_Tabellenzeile, 5).Value = cbWohnhaus.Value
    .DataBodyRange(P_Tabellenzeile, 6).Value = cbWohngruppe.Value
             

    End With

End If

'Userform schließen
Unload Me

'Blattschutz aktivieren
Call ws_protect(B_Bewohner)

   
   
   





'Userform schließen
Unload Me

'Blattschutz aktivieren
Call ws_protect(C_Prozess)






End Sub









Private Sub UserForm_Activate()

'cbStelle befüllen
cbWohnhaus.List = Range("tblWohnhaus").Value

'cbAbschluss befüllen
cbWohngruppe.List = Range("tblWohnhaus[Wohngruppe]").Value


'Anlegen oder Bearbeiten?
If P_BewohnerID = 0 Then

'BewohnerID ermitteln befüllen
txtBewohnerID.Value = WorksheetFunction.Max(Range("tblBewohner[BewohnerID]")) + 1



'Bearbeiten
Else

    With B_Bewohner.ListObjects("tblBewohner")

        'Tabellenzeile ermitteln
        P_Tabellenzeile = Range("tblBewohner[BewohnerID]").Find(P_BewohnerID, LookAt:=xlWhole).Row - .HeaderRowRange.Row
   
        'Eingabemaske befüllen
        txtBewohnerID.Value = P_BewohnerID
        txtVorname.Value = .DataBodyRange(P_Tabellenzeile, 2).Value
        txtNachname.Value = .DataBodyRange(P_Tabellenzeile, 3).Value
        txtGeburtsdatum.Value = .DataBodyRange(P_Tabellenzeile, 4).Value
        cbWohnhaus.Value = .DataBodyRange(P_Tabellenzeile, 5).Value
        cbWohngruppe.Value = .DataBodyRange(P_Tabellenzeile, 6).Value
     
   
    End With
   
    'Textfelder sperren
    txtVorname.Enabled = False
   
   
End If


End Sub


Private Sub UserForm_Initialize()
    Dim ws As Worksheet
    Dim rng As Range
    Dim cell As Range
    Dim dict As Object
   
    ' Set worksheet and range
    Set ws = ThisWorkbook.Sheets("Verweise")
    Set rng = ws.Range("A2", ws.Cells(ws.Rows.Count, "A").End(xlUp))
   
    ' Create dictionary to store unique main values
    Set dict = CreateObject("Scripting.Dictionary")
   
    ' Populate ComboBox1 with unique main values
    For Each cell In rng
        If Not dict.Exists(cell.Value) Then
            dict.Add cell.Value, Nothing
            cbWohnhaus.AddItem cell.Value
        End If
    Next cell
End Sub
Private Sub ComboBox1_Change()
    Dim ws As Worksheet
    Dim rng As Range
    Dim cell As Range
    Dim selectedMainValue As String
   
    ' Set worksheet
    Set ws = ThisWorkbook.Sheets("Verweise")
   
    ' Clear ComboBox2 items
    cbWohngruppe.Clear
   
    ' Get selected main value
    selectedMainValue = ComboBox1.Value
   
    ' Populate ComboBox2 based on selected main value
    Set rng = ws.Range("A2", ws.Cells(ws.Rows.Count, "A").End(xlUp))
    For Each cell In rng
        If cell.Value = selectedMainValue Then
            cbWohngruppe.AddItem cell.Offset(0, 1).Value
        End If
    Next cell
End Sub




Private Sub btnSpeichern_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

btnSpeichern.BackColor = RGB(76, 175, 80)

End Sub



Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

btnSpeichern.BackColor = RGB(113, 193, 117)


End Sub

Vielen Dank soweit! ICh habe den Code nun eingefügt, leicht verändert. Problem gibt es einerseits, dass in der cb1 die Überschriften immer nun mehrfach auftauchen, wie ich es eben in der Tabelle "Verweise" gemacht habe, ausgewählt werden können anstatt jeweils 1x. WHD / 1 , WHD / 2, WHD 3.... also man kann es mehrfach auswählen. Und in der 2. cb erscheint nicht die Option, die ich zuerst ausgewählt habe, sondern immer 1,2,3 ... also da sind noch ein paar Schwächen, wahrscheinlich durch meinen weiteren Code, die ich noch nicht finden kann. Würde mich sehr freuen, wenn Sie da nochmal rein gucken könnten. Vielen herzlichen Dank!