AW: 5 Comboboxen
07.12.2015 19:48:57
Nepumuk
Hallo,
da waren die Abfragen und die Collection an der falschen Stelle.
Option Explicit
Private Sub ComboBox1_Enter()
Dim aRow, iRow As Long
Dim col As New Collection
With Me
.ComboBox1.Clear
Sheets("Rohdaten").Select
aRow = IIf(IsEmpty(Range("A65536")), Range("A65536").End(xlUp).Row, 65536)
On Error Resume Next
For iRow = 2 To aRow
col.Add Cells(iRow, 1), Cells(iRow, 1)
If Err = 0 Then
.ComboBox1.AddItem Cells(iRow, 1)
Else
Err.Clear
End If
Next iRow
On Error GoTo 0
End With
End Sub
Private Sub ComboBox2_Enter()
Dim aRow, iRow As Long
Dim col As New Collection
With Me
.ComboBox2.Clear
Sheets("Rohdaten").Select
aRow = IIf(IsEmpty(Range("A65536")), Range("A65536").End(xlUp).Row, 65536)
On Error Resume Next
For iRow = 2 To aRow
If Cells(iRow, 1) = .ComboBox1.Value Then
col.Add Cells(iRow, 2), Cells(iRow, 2)
If Err = 0 Then
.ComboBox2.AddItem Cells(iRow, 2)
Else
Err.Clear
End If
End If
Next iRow
On Error GoTo 0
End With
End Sub
Private Sub ComboBox3_Enter()
Dim aRow, iRow As Long
Dim col As New Collection
With Me
.ComboBox3.Clear
Sheets("Rohdaten").Select
aRow = IIf(IsEmpty(Range("A65536")), Range("A65536").End(xlUp).Row, 65536)
On Error Resume Next
For iRow = 2 To aRow
If Cells(iRow, 1) = .ComboBox1.Value And _
Cells(iRow, 2) = .ComboBox2.Value Then
col.Add Cells(iRow, 3), Cells(iRow, 3)
If Err = 0 Then
.ComboBox3.AddItem Cells(iRow, 3)
Else
Err.Clear
End If
End If
Next iRow
On Error GoTo 0
End With
End Sub
Private Sub ComboBox4_Enter()
Dim aRow, iRow As Long
Dim col As New Collection
With Me
.ComboBox4.Clear
Sheets("Rohdaten").Select
aRow = IIf(IsEmpty(Range("A65536")), Range("A65536").End(xlUp).Row, 65536)
On Error Resume Next
For iRow = 2 To aRow
If Cells(iRow, 1) = .ComboBox1.Value And _
Cells(iRow, 2) = .ComboBox2.Value And _
Cells(iRow, 3) = .ComboBox3.Value Then
col.Add Cells(iRow, 4), Cells(iRow, 4)
If Err = 0 Then
.ComboBox4.AddItem Cells(iRow, 4)
Else
Err.Clear
End If
End If
Next iRow
On Error GoTo 0
End With
End Sub
Private Sub ComboBox5_Enter()
Dim aRow, iRow As Long
Dim col As New Collection
With Me
.ComboBox5.Clear
Sheets("Rohdaten").Select
aRow = IIf(IsEmpty(Range("A65536")), Range("A65536").End(xlUp).Row, 65536)
On Error Resume Next
For iRow = 2 To aRow
If Cells(iRow, 1) = .ComboBox1.Value And _
Cells(iRow, 2) = .ComboBox2.Value And _
Cells(iRow, 3) = .ComboBox3.Value And _
Cells(iRow, 4) = .ComboBox4.Value Then
col.Add Cells(iRow, 5), Cells(iRow, 5)
If Err = 0 Then
.ComboBox5.AddItem Cells(iRow, 5)
Else
Err.Clear
End If
End If
Next iRow
On Error GoTo 0
End With
End Sub
Gruß
Nepumuk