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
Hallo Joe,
ersetze einfach die 2 durch eine 4 in beiden Makros in der jeweiligen Zeile
For iRow = 2 To aRow
Gruß Uwe
Hallo Uwe,
Danke, klappt super!
Gruß 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
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
(20.10.2015, 12:17)Joe schrieb: [ -> ]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
Hallo Uwe,
Besten Dank, jetzt hab ich die Funktion With verstanden, shame on me das ich das nicht früher wusste.
Gruß Joe