title image


Smiley Re: Mehrspaltige Combo mit Werten aus Tabelle füllen
Hallo NoNet!



Danke für Deine Antwort.





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 Textboxen 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.





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: