title image


Smiley Kein Wert in der TextBox
Hallo!



In meinem Projekt habe ich in einer Userform 4 ComboBoxen, welche ab der 2. CB abhängig von der vorigen befüllt werden.



Es würde jetzt alles ungefähr so klappen, die ComboBoxen werden richtig befüllt und auch die letzte die cboNamen3 wird richtig zweispaltig befüllt und danach auch angezeigt. Mein Problem ist jedoch noch eines:

Ich habe jetzt schon so ziemlich alles ausprobiert, ich bringe keine Daten in die Textbox1.

Mein gesuchte Lösung wäre, dass nach Auswahl in der cboNamen3 mehrere Textboxen mit den Daten dieses Datensatzes gefüllt werden.





Private Sub cboNamen3_Change()

On Error Resume Next

cboNamen3.Text = cboNamen3.Column(0) & " " & cboNamen3.Column(1)



TextBox1 = cboNamen3.Column(1)<<<<<<<<<<< HIER LIEGT ZUR ZEIT MEIN PROBLEM

End Sub



Wenn die Zeile

cboNamen3.Text = cboNamen3.Column(0) & " " & cboNamen3.Column(1)



in der cboNamen3_Change aktiviert ist wird die ComboBox zwar zweispaltig befüllt jedoch die Textbox1 bleibt leer,



setze ich die Zeile

cboNamen3.Text = cboNamen3.Column(0) & " " & cboNamen3.Column(1) ausser Kraft

wird zwar die TextBox1 befüllt, jedoch wird in der cboNamen3 nur der erste Wert angezeigt.



Ich bräuchte jedoch beide Werte in der cboNamen3 und den Wert in der Textbox1.







die Reihenfolge der ComboBoxen:

cboNamen5

cboNamen4

cboNamen2

cboNamen3



hier wäre der Code:



Private Sub cboNamen3_Change()

On Error Resume Next

cboNamen3.Text = cboNamen3.Column(0) & " " & cboNamen3.Column(1)

cboNamen3.Text = cboNamen3.Column(1)



TextBox1 = cboNamen3.Column(1)<<<<<<<<<<< HIER LIEGT ZUR ZEIT MEIN PROBLEM

End Sub



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 As Long

Dim iRow As Long

Dim wks As Worksheet

Set wks = ThisWorkbook.Sheets("Tabelle1")

Dim lCoBo As Long

'Dim col As New Collection

With cboNamen3

.Clear ' löschen ComboBox

.ColumnCount = 2 ' drei Spalten

.ColumnWidths = "1,8 cm; 12,0 cm" ' Breite der Spalten

.ListRows = 4 '12 ' angezeigte Zeilen

'.Height = 20 ' Höhe der ComboBox

'.Font.Size = 8 ' Schriftgröße

' .BackColor = RGB(204, 255, 204) ' Hintergrundfarbe

End With



aRow = IIf(IsEmpty(wks.Range("A65536")), wks.Range("A65536").End(xlUp).Row, 65536)



On Error Resume Next



For iRow = 1 To aRow

With wks

If .Cells(iRow, 4) = cboNamen5 _

And .Cells(iRow, 5) = cboNamen4 _

And .Cells(iRow, 6) = cboNamen2 Then

'col.Add Workbooks("32648_3.xls").Worksheets("Tabelle1").Cells(iRow, 1), _

Workbooks("32648_3.xls").Worksheets("Tabelle1").Cells(iRow, 7)

If Err = 0 And _

wks.Cells(iRow, 6) = _

cboNamen2.Value Then

cboNamen3.AddItem ""

cboNamen3.List(lCoBo, 0) = _

wks.Cells(iRow, 8)

cboNamen3.List(lCoBo, 1) = _

wks.Cells(iRow, 7)

lCoBo = lCoBo + 1

Else

Err.Clear

End If

End If

End With

Next iRow

On Error GoTo 0

End Sub







Danke





Josef



geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: