AW: Combobox 1+2 suchen wert eintrag
27.03.2020 20:40:24
Matthias
Moin!
Dann ändere den Code vom Commandbutton3 mal so. Damit wird es eingetragen. Für Montagvormittag, schreib nur Montagvormittag ohne die Zahlen hinten rein. Dann geht der Code auch. Ansonsten muss man wieder zuviel anpassen.
Private Sub CommandButton3_Click()
Dim lZeil As Long
Dim lListBox As Long
Dim NextKursID As Long
Dim NextID As Long
Dim NextCell As Long
NextKursID = Application.Max(Sheets("Kursteilnahmen").Range("G:G")) + 1
NextID = Application.Max(Sheets("Kursteilnahmen").Range("A:A")) + 1
NextCell = 2
Do While Trim(CStr(Worksheets("Kursteilnahmen").Cells(NextCell, 1).Value)) ""
NextCell = NextCell + 1
Loop
lZeil = 2
For lListBox = 0 To ListBox4.ListCount - 1
Worksheets("Kursteilnahmen").Range("A" & CDbl(NextCell) + lListBox).Value = CDbl(NextID) + _
lListBox
Worksheets("Kursteilnahmen").Range("B" & CDbl(NextCell) + lListBox).Value = ListBox4.List( _
lListBox, 0)
Worksheets("Kursteilnahmen").Range("C" & CDbl(NextCell) + lListBox).Value = ListBox4.List( _
lListBox, 1)
Worksheets("Kursteilnahmen").Range("D" & CDbl(NextCell) + lListBox).Value = ListBox4.List( _
lListBox, 2)
Worksheets("Kursteilnahmen").Range("E" & CDbl(NextCell) + lListBox).Value = ListBox4.List( _
lListBox, 3)
Worksheets("Kursteilnahmen").Range("F" & CDbl(NextCell) + lListBox).Value = ListBox4.List( _
lListBox, 4)
Worksheets("Kursteilnahmen").Range("G" & CDbl(NextCell) + lListBox).Value = CDbl(NextKursID) _
Worksheets("Kursteilnahmen").Range("H" & CDbl(NextCell) + lListBox).Value = TextBox20.Text
Worksheets("Kursteilnahmen").Range("I" & CDbl(NextCell) + lListBox).Value = TextBox19.Text
Worksheets("Kursteilnahmen").Range("J" & CDbl(NextCell) + lListBox).Value = TextBox18.Text
Worksheets("Kursteilnahmen").Range("K" & CDbl(NextCell) + lListBox).Value = TextBox17.Text
Worksheets("Kursteilnahmen").Range("L" & CDbl(NextCell) + lListBox).Value = TextBox21.Text
Worksheets("Kursteilnahmen").Range("M" & CDbl(NextCell) + lListBox).Value = TextBox16.Text
Worksheets("Kursteilnahmen").Range("N" & CDbl(NextCell) + lListBox).Value = TextBox15.Text
Worksheets("Kursteilnahmen").Range("P" & CDbl(NextCell) + lListBox).Value = TextBox14.Text
Next lListBox
'Testversuch 19.03.2020 funktioniert zum Teil nur noch Eintrag in der Falschen zeile, eintrag ü _
ber Userform Direkt an gewünschten Platz'
'Dim lngErste As Long
' With Worksheets("Anwesenheit") 'Eintrag nach Bestätigung einfügen'
' lngErste = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, . _
Rows.Count) + 1
' If Me.ComboBox1.Column(0) = "Montagvormittag 1" Then
' .Cells(lngErste, 4) = Me.TextBox25
' .Cells(lngErste, 5) = Me.TextBox27
' .Cells(lngErste, 9) = Me.ComboBox5
' End If
' End With
'test 27.03.2020 funktioniert
Dim rngAuswahl As Range
With Worksheets("Anwesenheit") 'Eintrag nach Bestätigung einfügen'
Set rngAuswahl = .Columns(2).Find(Me.ComboBox1.Value, lookat:=xlWhole)
'Set rngAuswahl = .Columns(3).Find(Me.ComboBox6.Value, lookat:=xlWhole) 'test24.03.2020
If Not rngAuswahl Is Nothing Then
' noch niemand eingetragen dann eintragen
' If .Cells(rngAuswahl, 4) = " " Then
If .Cells(rngAuswahl.Row + Me.ComboBox6.ListIndex, 4) = "" Then
.Cells(rngAuswahl.Row + Me.ComboBox6.ListIndex, 4) = Me.TextBox25
.Cells(rngAuswahl.Row + Me.ComboBox6.ListIndex, 5) = Me.TextBox27
.Cells(rngAuswahl.Row + Me.ComboBox6.ListIndex, 9) = Me.ComboBox5
' Label45.Caption = "Platz ist frei" 'Wenn Platz frei dann schreib es in textlabel _
rein
' CommandButton9.Enabled = True
' Else
' Label45.Caption = "Schon belegt, bitte eine andere Auswahl treffen" 'Ist Platz _
nicht frei dann schreib in textlabel rein
' MsgBox "Schon belegt, bitte eine andere Auswahl treffen"
End If
' Else
' MsgBox Me.ComboBox1.Value & " nicht vorhanden"
End If
End With
Unload Me
End Sub
VG