Inhalt der combobox wird nicht erkannt
27.10.2013 19:22:55
Markus
ich habe drei Comboboxen, die abhängig von der Vorherigen jeweils gefüllt werden sollen. Das Ausfüllen der zweiten funktioniert ohne Probleme, bei der dritten allerdings scheint es so, dass das Datum was in der zweiten ausgewählt wird, in der Datenbank nicht gefunden wird, da die dritte Combobox leer bleibt.
Option Explicit
'Modulweite Variablen deklarieren
Const C_mstrDatenblatt As String = "Datenbank"
Const C_mstrDatenblatt2 As String = "Hilfe"
Dim mobjDic As Object
Dim mlngLast As Long
Dim mlngZ As Long
Private Sub ComboBox1_Enter()
'Erste Combobox. Jedes Land in Spalte A wird einmalig angezeigt
Set mobjDic = CreateObject("Scripting.Dictionary")
For mlngZ = 2 To mlngLast
mobjDic(Worksheets(C_mstrDatenblatt2).Cells(mlngZ, 6).Value) = 0
Next
Me.ComboBox1.List = mobjDic.keys
Set mobjDic = Nothing
End Sub
Private Sub ComboBox2_Enter()
'Zweite Combobox in Abhängigkeit von Combobox1.
Set mobjDic = CreateObject("Scripting.Dictionary")
With Worksheets(C_mstrDatenblatt)
For mlngZ = 2 To mlngLast
If .Cells(mlngZ, 5).Value = Me.ComboBox1.Value Then
mobjDic(.Cells(mlngZ, 7).Value) = 0
End If
Next
End With
Me.ComboBox2.List = mobjDic.keys
Set mobjDic = Nothing
End Sub
Private Sub ComboBox3_Enter()
Set mobjDic = CreateObject("Scripting.Dictionary")
Me.ComboBox3.Clear
With Worksheets(C_mstrDatenblatt)
For mlngZ = 2 To mlngLast
If .Cells(mlngZ, 5).Value = Me.ComboBox1.Value And .Cells(mlngZ, 7).Value = Me.ComboBox2. _
Value Then
mobjDic(.Cells(mlngZ, 6).Value) = 0
End If
Next
End With
Me.ComboBox3.List = mobjDic.keys
Set mobjDic = Nothing
End Sub
Wird die dritte Combobox nur von der ersten abhängig gemacht, wird diese gefüllt.
Mach ich sie nur von der zweiten abhängig, bleibt die dritte combobox leer. Daraus vermute ich, dass er er das Datum, was er sich ja aus der Datenbank zieht, nicht wieder findet.
Private Sub ComboBox3_Enter()
Set mobjDic = CreateObject("Scripting.Dictionary")
Me.ComboBox3.Clear
With Worksheets(C_mstrDatenblatt)
For mlngZ = 2 To mlngLast
If .Cells(mlngZ, 5).Value = Me.ComboBox1.Value Then
mobjDic(.Cells(mlngZ, 6).Value) = 0
End If
Next
End With
Me.ComboBox3.List = mobjDic.keys
Set mobjDic = Nothing
End Sub
Private Sub CommandButton1_Click()
Dim rngCell As Range
Dim strFirstAddress As String
If ComboBox1.Value = "" Then
MsgBox "Bitte Schulung auswählen.", vbExclamation, "Manitowoc"
ComboBox1.BackColor = RGB(255, 255, 0)
ComboBox1.SetFocus
Exit Sub
End If
If ComboBox2.Value = "" Then
MsgBox "Bitte Schulungsbeginn auswählen.", vbExclamation, "Manitowoc"
ComboBox2.BackColor = RGB(255, 255, 0)
ComboBox2.SetFocus
ComboBox1.BackColor = RGB(255, 255, 255)
Exit Sub
End If
ComboBox2.BackColor = RGB(255, 255, 255)
With Worksheets("Datenbank").Range("E:G")
Me.ListBox1.Clear
Set rngCell = .Find(Me.ComboBox1.Value, LookIn:=xlValues, lookat:=xlWhole)
If Not rngCell Is Nothing Then
strFirstAddress = rngCell.Address
Do
'Beispiel auf Prüfung von 'Vorname', der in TextBox 2 eingetragen wird
If rngCell.Offset(0, 2) Like Me.ComboBox2.Value Then
With Me.ListBox1
.ColumnCount = 4
.AddItem
.List(.ListCount - 1, 0) = rngCell.Offset(0, -2).Value & " " & rngCell.Offset(0, - _
3).Value
.List(.ListCount - 1, 1) = rngCell.Offset(0, -1).Value
.List(.ListCount - 1, 2) = rngCell.Offset(0, 7).Value
.List(.ListCount - 1, 3) = rngCell.Offset(0, 6).Value
TextBox1.Value = rngCell.Value
'ComboBox3.Value = rngCell.Offset(0, 1).Value
TextBox3.Value = rngCell.Offset(0, 4).Value
TextBox4.Value = rngCell.Offset(0, 2).Value
TextBox5.Value = rngCell.Offset(0, 3).Value
.ColumnWidths = "4cm;4cm;2cm;7cm"
End With
End If
Set rngCell = .FindNext(rngCell)
Loop While Not rngCell Is Nothing And rngCell.Address strFirstAddress
Else
MsgBox "Abteilung nicht gefunden", 48
End If
End With
End Sub
Danke schon mal.
Gruß Markus
Anzeige