VBA: Abhängige Combobox

[Joe]

Guten Tag Zusammen,

ich hab zwei Comboboxen die jeweils abhängig von einander sind.
Mein Code funktioniert auch sehr gut so weit, aber der soll erst ab der 4. Zeile Anfangen, das kriege ich nicht.
Könnt ihr den mir bitte vebessern?

Code:

   Option Explicit

Dim aRow As Long
Dim col As New Collection
Dim iRow, x As Long


Private Sub cbo1_Change()

cbo2.Clear

On Error Resume Next
For iRow = 2 To aRow
    col.Add Cells(iRow, 8), Cells(iRow, 8)
    If Err = 0 And Cells(iRow, 7) = cbo1.Value Then
        cbo2.AddItem Cells(iRow, 8)
    Else
        Err.Clear
    End If
Next iRow
On Error GoTo 0
For x = col.Count To 1 Step -1
    col.Remove (x)
Next x
  

Private Sub UserForm_Initialize()

'Auswahl für die ComboBox Profil

aRow = IIf(IsEmpty(Worksheets("Tabellen").Range("G4:G65536")), Worksheets("Tabellen").Range("G4:G65536").End(xlUp).Row, 65536)
On Error Resume Next
For iRow = 2 To aRow
    col.Add Cells(iRow, 7), Cells(iRow, 7)
    If Err = 0 Then
        cbo1.AddItem Cells(iRow, 7)
    Else
        Err.Clear
    End If
Next iRow
On Error GoTo 0

Wenn ihr auch einen anderen Code habt den ihr besser findet nur her damit.

Gruß Joe

[Kuwer]

Hallo Joe,

ersetze einfach die 2 durch eine 4 in beiden Makros in der jeweiligen Zeile

For iRow = 2 To aRow

Gruß Uwe

[Joe]

Hallo Uwe,

Danke, klappt super!

Gruß Joe

[Joe]

Hallo,

Doch noch ein Problem...
Wenn ich ein anderes Tabellenblatt auf habe, dann das Makro starte, geht das nicht mehr.
Wie kriege ich es hin das er genau sich nur auf das Worksheet "Tabellen" bezieht?

Gruß Joe

[Joe]

Also jetzt hab ich es geschafft, aber das Problem ist, dass das Makro jetzt ziemlich langsam ist.

Code:

Option Explicit

Dim aRow As Long
Dim col As New Collection
Dim iRow, x As Long

Private Sub cbo1_Change()

cboTypFahrkorb.Clear

On Error Resume Next
For iRow = 4 To aRow
    col.Add Worksheets("Tabellen").Cells(iRow, 8), Worksheets("Tabellen").Cells(iRow, 8)
    If Err = 0 And Worksheets("Tabellen").Cells(iRow, 7) = cbo1.Value Then
        cbo2.AddItem Worksheets("Tabellen").Cells(iRow, 8)
    Else
        Err.Clear
    End If
Next iRow
On Error GoTo 0
For x = col.Count To 1 Step -1
    col.Remove (x)
Next x

End Sub

Private Sub UserForm_Initialize()

aRow = IIf(IsEmpty(Worksheets("Tabellen").Range("G4:G65536")), Worksheets("Tabellen").Range("G4:G65536").End(xlUp).Row, 65536)
On Error Resume Next
For iRow = 4 To aRow
    col.Add Worksheets("Tabellen").Cells(iRow, 7), Worksheets("Tabellen").Cells(iRow, 7)
    If Err = 0 Then
        cbo1.AddItem Worksheets("Tabellen").Cells(iRow, 7)
    Else
        Err.Clear
    End If
Next iRow
On Error GoTo 0

End Sub

Gruß Joe

[Kuwer]

Wie kriege ich es hin das er genau sich nur auf das Worksheet "Tabellen" bezieht?

Hallo Joe,

dazu eignet sich die With-Anweisung sehr gut. Beachte die Punkte vor den Zellenangaben. Sie stellen den Bezug zum mit With angegebenen Objekt (hier dem Tabellenblatt) her.
Die maximale Zeilenanzahl habe ich flexibel gestaltet, da E2010 ein wenig mehr als 65536 Zeilen hat.

Option Explicit



Dim aRow As Long

Dim col As New Collection

Dim iRow As Long, x As Long





Private Sub cbo1_Change()



 cbo2.Clear

 

 On Error Resume Next

 With Worksheets("Tabellen")

   For iRow = 2 To aRow

     col.Add .Cells(iRow, 8).Value, .Cells(iRow, 8).Value

     If Err = 0 And .Cells(iRow, 7).Value = cbo1.Value Then

       cbo2.AddItem .Cells(iRow, 8).Value

     Else

       Err.Clear

     End If

   Next iRow

 End With

 On Error GoTo 0

 For x = col.Count To 1 Step -1

   col.Remove (x)

 Next x

End Sub



Private Sub UserForm_Initialize()

 'Auswahl für die ComboBox Profil

 With Worksheets("Tabellen")

   aRow = IIf(IsEmpty(.Cells(.Rows.Count, 7)), .Cells(.Rows.Count, 7).End(xlUp).Row, .Rows.Count)

   On Error Resume Next

   For iRow = 2 To aRow

     col.Add .Cells(iRow, 7).Value, .Cells(iRow, 7).Value

     If Err = 0 Then

       cbo1.AddItem .Cells(iRow, 7).Value

     Else

       Err.Clear

     End If

   Next iRow

   On Error GoTo 0

 End With

End Sub

Code eingefügt mit: Excel Code Jeanie

Gruß Uwe

[Joe]

Hallo Uwe,

Besten Dank, jetzt hab ich die Funktion With verstanden, shame on me das ich das nicht früher wusste.

Gruß Joe