AW: Bitte um Hilfe bei Befüllen von ComboBoxen
04.05.2006 14:51:16
u_
Hallo,
du hast einen Logikfehler drin. Du musst erst prüfen, ob die Nachbarzellen mit den vorhergehenden CBOs übereinstimmen und dann den Wert der Collection hinzufügen. Sonst kann es passieren, dass die Collection den Wert schon hat, obwohl dieser nicht mit den anderen CBOs korrespondiert. Dann bekommst du einen Fehler und der CBO wird nichts hinzugefügt. Außerdem musst du alle vorhergehenden CBOs checken und nicht nur die umnittelbar davor liegende.
Try this:
Private Sub cboNamen5_Enter()
Dim aRow, iRow As Long
Dim wks As Worksheet
Set wks = ThisWorkbook.Sheets("Tabelle1")
Dim col As New Collection
cboNamen5.Clear
aRow = IIf(IsEmpty(wks.Range("A65536")), wks.Range("A65536").End(xlUp).Row, 65536)
On Error Resume Next
For iRow = 2 To aRow
With wks
col.Add wks.Cells(iRow, 1), wks.Cells(iRow, 4)
If Err = 0 Then
cboNamen5.AddItem .Cells(iRow, 4)
Else
Err.Clear
End If
End With
Next iRow
On Error GoTo 0
'Call Sortieren_CboN5
End Sub
Private Sub cboNamen4_Enter()
Dim aRow, iRow As Long
Dim col As New Collection
Dim wks As Worksheet
Set wks = ThisWorkbook.Sheets("Tabelle1")
cboNamen4.Clear
aRow = IIf(IsEmpty(wks.Range("A65536")), wks.Range("A65536").End(xlUp).Row, 65536)
On Error Resume Next
For iRow = 2 To aRow
With wks
If .Cells(iRow, 4) = cboNamen5 Then
col.Add wks.Cells(iRow, 1), wks.Cells(iRow, 5)
If Err = 0 Then
cboNamen4.AddItem .Cells(iRow, 5)
Else
Err.Clear
End If
End If
End With
Next iRow
On Error GoTo 0
'Call Sortieren_CboN4
End Sub
Private Sub cboNamen2_Enter()
Dim aRow, iRow As Long
Dim col As New Collection
Dim wks As Worksheet
Set wks = ThisWorkbook.Sheets("Tabelle1")
cboNamen2.Clear
aRow = IIf(IsEmpty(wks.Range("A65536")), wks.Range("A65536").End(xlUp).Row, 65536)
On Error Resume Next
For iRow = 2 To aRow
With wks
If .Cells(iRow, 4) = cboNamen5 _
And .Cells(iRow, 5) = cboNamen4 Then
col.Add wks.Cells(iRow, 1), wks.Cells(iRow, 6)
If Err = 0 Then
cboNamen2.AddItem .Cells(iRow, 6)
Else
Err.Clear
End If
End If
End With
Next iRow
On Error GoTo 0
'Call Sortieren_CboN2
End Sub
Private Sub cboNamen3_Enter()
Dim aRow, iRow As Long
Dim wks As Worksheet
Set wks = ThisWorkbook.Sheets("Tabelle1")
Dim col As New Collection
cboNamen3.Clear
aRow = IIf(IsEmpty(wks.Range("A65536")), wks.Range("A65536").End(xlUp).Row, 65536)
On Error Resume Next
For iRow = 2 To aRow
With wks
If .Cells(iRow, 4) = cboNamen5 _
And .Cells(iRow, 5) = cboNamen4 _
And .Cells(iRow, 6) = cboNamen2 Then
col.Add wks.Cells(iRow, 1), wks.Cells(iRow, 7)
If Err = 0 Then
cboNamen3.AddItem .Cells(iRow, 7)
Else
Err.Clear
End If
End If
End With
Next iRow
On Error GoTo 0
'Call Sortieren_CboN3
End Sub
Gruß
Geist ist geil!
(Dies ist ein allgemeines Statement und nicht an bestimmte Personen gerichtet.)