VBA-Zelle mit "Name, Vorname" wird nicht komplett angezeigt
16.10.2023 16:39:05
Dieter Klein
wir schreiben gerade eine Anwendung für unsere Azubis und haben folgendes Problem:
Die Namen der Azubis sind mit "Name, Vorname" abgelegt in der AzubiList abgelegt.
Im Rotationsplan wird in der Dropdown-Liste alle Azubis angezeigt, die nicht in der Abteilung waren.
Egal wo in der Anwendung auf die Namensliste zugreift, wird der Name und der Vorname korrekt angezeigt, außer hier im Rotationsplan.
Hier wird der Name als Auswahlmöglichkeit angeboten, aber auch der Vorname, d.h. die Liste wird doppelt so lange und beim auswählen wird auch nur der jeweilige Name angezeigt.
Hier im Anhang ist der Code von diesem Modul.
Wäre toll, wenn jemand von euch eine Idee hätte.
Danke und Gruß
Sub ErstelleDropdownliste()
Dim DatenWs As Worksheet
Dim GewWs As Worksheet
Dim AzubiWs As Worksheet
Dim Abteilung As Range
Dim AzubiCell As Range
Dim AzubiRange As Range
Dim LastRow As Long
Dim i As Long
Set DatenWs = ThisWorkbook.Sheets("Datengrundlage_Rotationspläne")
Set GewWs = ThisWorkbook.Sheets("Rotp._Gew")
Set AzubiWs = ThisWorkbook.Sheets("Datengrundlage_Rotationspläne")
LastRow = DatenWs.Cells(DatenWs.Rows.Count, "K").End(xlUp).Row
Set AzubiRange = DatenWs.Range("C4:C" & LastRow)
For Each Abteilung In GewWs.Range("C6:C100")
If WorksheetFunction.CountIf(DatenWs.Range("L2:L" & LastRow), Abteilung.Value) = 0 Then
Dim AzubiList As String
AzubiList = ""
For Each AzubiCell In AzubiRange
If AzubiCell.Offset(0, 1).Value = "" Then
AzubiList = AzubiList & AzubiCell.Value & ", "
Else
AzubiList = AzubiList & AzubiCell.Value & " " & AzubiCell.Offset(0, 1).Value & vbCrLf
End If
Next AzubiCell
AzubiList = Left(AzubiList, Len(AzubiList) - 2)
GewWs.Range("K" & Abteilung.Row).Validation.Delete
GewWs.Range("K" & Abteilung.Row).Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=AzubiList
GewWs.Range("K" & Abteilung.Row).Validation.InCellDropdown = True
Else
GewWs.Range("K" & Abteilung.Row).Validation.Delete
End If
Next Abteilung
End Sub