Abhaengige ComboBox - automatische Zeilenausgabe
26.05.2009 15:32:32
AnRo
ich bin absoluter vb anfaenger und moechte folgende Loesung mit vb realisieren.
Ein Dateiname soll automatisch generiert werden. Hierzu werden drei Comboboxen ausgewaehlt und danach soll der Dateiname entsprechend der Auswahl ausgegeben werden.
Hierzu habe ich bereits folgende Code zusammengebastelt, welcher soweit auch funktioniert, jedoch habe ich folgende Anpassungen, bei welchen ich nicht weiterkomme.
Zum ersten soll entgegen der 1ten und 2ten Combobox bei der 3ten Combobox auch die Anzeige gleicher also doppelter Namen moeglich sein.
In einer vierten Spalte steht der Dateiname, welcher anschliessend auf dem Bildschirm angezeigt werden soll hierzu benoetige ich folgende Loesung. Sollte die letzte Auswahl also bspw. aus Combobox 3 in C24 stehen, soll der Name in Reihe D24 ausgegeben werden. Bei C210 entsprechend D210.
Uebere eure Hilfe bin ich dankbar anbei der Code:
Option Explicit
Dim aRow As Long
Dim col As New Collection
Dim iRow, x As Long
Private Sub ComboBox1_Change()
ComboBox2.Clear
ComboBox3.Clear
On Error Resume Next
For iRow = 2 To aRow
col.Add Cells(iRow, 2), Cells(iRow, 2)
If Err = 0 And Cells(iRow, 1) = ComboBox1.Value Then
ComboBox2.AddItem Cells(iRow, 2)
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 ComboBox2_Change()
ComboBox3.Clear
On Error Resume Next
For iRow = 2 To aRow
col.Add Cells(iRow, 3), Cells(iRow, 3)
If Err = 0 And Cells(iRow, 2) = ComboBox2.Value Then
ComboBox3.AddItem Cells(iRow, 3)
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(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 Sub
Viele Gruesse,
Andreas