Dynamische Auswahlliste (dropdown) für Schichtplan

Bild

Betrifft: Dynamische Auswahlliste (dropdown) für Schichtplan
von: JensK
Geschrieben am: 27.10.2015 16:26:37

Hallo,
ich bin dabei ein Template für einen Schichtplan zu erstellen. Dabei sollen die Mitarbeiter mittels Dropdown-Liste eingetragen werden. Im Bereich Abwesend kann eingetragen werden wer abwesend ist. Soweit sogut. Nun soll aber in der Schichtplanung die Gropdown-Liste um die Einträge aus Abwesend verringert werden. Wer also unter abwsend eingetragen wurde soll nicht in der Liste für die Schichtplanung verfügbar sein.
Die Planung erfolgt im Sheet "Schichtplan" unter "Frühschicht", "Spätschicht" und "Bereitschaft" - die der nicht verfügbaren unter "Abwesend".
Die Ausgangsdaten sind unter dem Sheet "Daten" definiert.
https://www.herber.de/bbs/user/101075.xlsm
Wie kann man also dynamisch Einträge aus einer Dropdown-Liste ausblenden (am Beispiel hier A. Dittmer und J. Klose) temporär entfernen).
In freudiger Erwartung ;)
Jens

Bild

Betrifft: AW: nachgefragt ...
von: ... neopa C
Geschrieben am: 27.10.2015 16:53:10
Hallo Jens,
... das ist wohl etwas komplexer als Du es bisher beschrieben hast? Oder?
Die Abwesenden können doch sicherlich je Tag verschiedene Personen sein und eine Person die nicht abwesend ist aber schon z.B. zur Frühschicht zugeteilt ist, wird wohl kaum zur Spätschicht zugeteilt werden sollen und oder auch noch Bereitschaft haben müssen.
Dann willst Du offensichtlich je Schicht bis zu drei Personen zuweisen können. Auch da darf es keine Überlappungen geben.
Außerdem vermute ich, dass Deine "x"en zu den Kategorien: A, B, C" in Daten!E:G noch eine Rolle spielen. Oder?
Gruß Werner
.. , - ...

Bild

Betrifft: AW: nachgefragt ...
von: Jensk
Geschrieben am: 27.10.2015 17:37:13
Hallo Werner,
ich bin nicht sicher ob ich es soweit treiben möchte das die "x"en wirklich zum Tragen kommen. Weil dass ist auch aus meiner Sicht ziemlich komplex und ich würde da vermutlich in VBA weitermachen. Ich könnte mir vorstellen dass man da mit Arrays weiterkommen könnte.
Aber ja, die Abwesenden können je Tag verschiedene Personen sein. Aus Prozesssicht wird aber erst die Abwesenheit der Kollegen für den Folgemonat ermittelt und eingetragen. Basierend darauf sollen in den linken Spalten in der Planung dann die Gesamtliste um die abwesenden reduziert werden. Auch hier habe ich eine gaaaanz vage Vorstellung das es evtl. über eine Matrixfunktion funktionieren könnte. Da ich zu diesem Thema aber bisher NULL Erfahrungen habe und es sich um Strings und nicht um Zahlen handelt bin ich da im Moment eher ratlos.
Eine Plausiprüfung in den Planungsspalten möchte ich aus Aufwandsgründen eigentlich auch nicht umsetzen. Zumal die Bereitschaft immer die von den Spätschichtkollegen übernommen wird. Auch werden die jeweils 3 Bereiche pro Schicht von 2 Kollegen übernommen - also einer der beiden ist für zwei Bereiche zuständig. Noch mehr Details werden hier aber mehr verwirrend als hilfreich.
Ziel ist die Abwesenden dynamisch aus der Gesamtliste (temporär) zu entfernen (sie nicht auswählbar zu machen).
Gruß
JensK

Bild

Betrifft: AW: nachgefragt ...
von: Matthias
Geschrieben am: 28.10.2015 01:20:24
Wenn du mir noch sagst, was es mit den "x"en aufsich hat, kann man das evtl noch einbringen.
lg Matthias

Bild

Betrifft: AW: nachgefragt ...
von: Matthias
Geschrieben am: 28.10.2015 01:20:56
Stelle wieder auf offen.

Bild

Betrifft: AW: nachgefragt ...
von: JensK
Geschrieben am: 28.10.2015 08:23:47
Hallo Matthias,
in den Bereichen Frühschicht, Spätschicht und Bereitschaft gibt es 3 je drei Spalten. Diese stehen für je einen Kunden-/Themenbereich. Jeder der MA bearbeitet einen oder mehrere dieser Bereiche, welchen wird durch die Kreuze definiert. Dies kann sich aber auch ändern (durch Neue Themen, Schulungen wodurch die MA auch andere Bereiche bearbeiten können, ... - ist zwar nicht sehr dynamisch, kann aber vorkommen). eine Vorauswahl in der Dropdow-Liste wäre zwar Premium, müsste aber durch setzen der Kreuze flexibel sein. Am wichtigsten ist mir aber, dass die Abwesenden nicht in der Liste auftauchen.
Einen entscheidenden Punkt sehe ich aber gerade noch. Die MA sind in 2 Teams (Köln und Offenburg). Wenn z.B. Team Offenburg abwesend ist (z.B. wegen lokalem Feiertag oder ...) dann wäre es genial wenn die MA, die diesem Team zugeordnet sind von der Dropdown-Liste verschwinden würden.
Anbei die aktualisierte Datei. Sorry für den Nachtrag, aber manche Dinge fallen einem ein, wenn man sie jemandem erklären muss.
https://www.herber.de/bbs/user/101085.xlsm
Danke und lg
JensK

Bild

Betrifft: AW: nachgefragt ...
von: Matthias
Geschrieben am: 28.10.2015 01:02:55
Hallo Jens,
zunächst einmal deinen Bereich Abwesend mit einer Datenüberprüfung versehen, damit die Namen nur korrekt eingegeben werden können:
Spalten D:AG markieren
Daten - Datenüberprüfung - Zulassen:Liste, Quelle: =Daten!D2:D20
Für die Kopfzeile kannst du die Datenüberprüfung auch wieder rausnehmen, wenn dir danach ist, muss aber nicht.
Die Datenüberprüfung ist nur für den Anfang und wird durch einen Eintrag im Bereich Abwesend _ von folgendem Ereignis überschrieben:


Private Sub Worksheet_Change(ByVal Target As Range)
Dim rZelle As Range, rDaten As Range
Dim fRow() As Long, fDaten()
Dim i As Long, j As Long
Dim sFormula As String
'Eingabebereich = "Abwesend"
If Not Intersect(Target, Range("P:AG")) Is Nothing Then
    
    With Sheets("Daten") 'Liste der Namen
        Set rDaten = .Range("D2:D" & .Cells(.Rows.Count, 4).End(xlUp).Row)
    End With
    
    'Bestimmung betroffener Zeilen
    ReDim fRow(0)
    For Each rZelle In Intersect(Target, Range("P:AG")).Cells
        For i = LBound(fRow) To UBound(fRow)
            If rZelle.Row = fRow(i) Then GoTo NextrZelle1
        Next i
        'Zeilen merken
        If rZelle.Row > 3 Then
            ReDim Preserve fRow(UBound(fRow) + 1)
            fRow(UBound(fRow)) = rZelle.Row
        End If
        
NextrZelle1:
    Next rZelle
    
    'Für jede Zeile Datenüberprüfung setzen
    For i = fRow(LBound(fRow) + 1) To fRow(UBound(fRow))
        ReDim fDaten(0)
        For Each rZelle In rDaten.Cells
            For j = 16 To 33 'P:AG
                If rZelle = Cells(i, j) Then GoTo NextrZelle2
            Next j
            ReDim Preserve fDaten(UBound(fDaten) + 1)
            fDaten(UBound(fDaten)) = rZelle
NextrZelle2:
        Next rZelle
        
        'Inhalt der Liste bestimmen
        For j = LBound(fDaten) + 1 To UBound(fDaten)
            If j = 1 Then
                sFormula = CStr(fDaten(j))
            Else
                sFormula = sFormula & "," & CStr(fDaten(j))
            End If
        Next j
        'Liste der DÜ setzen
        With Range(Cells(i, 4), Cells(i, 33)).Validation 'D:AG
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
            Operator:=xlBetween, Formula1:=sFormula
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .ShowInput = True
            .ShowError = True
        End With
    Next i
End If
End Sub
Mit VBA Gut brauch ich sicher nicht erklären wo das hinkommt und wie du die genauen Einstellungen zur Datenüberprüfung nach deinem Belieben defnieren kannst.
lg Matthias

Bild

Betrifft: AW: nachgefragt ...
von: Matthias
Geschrieben am: 28.10.2015 01:16:48
Kleine Ergänzung:
wenn du den Bereich von Intersect(Target, Range("P:AG") auf "D:AG" erweiterst (2 Stellen im Code) und in folgener Zeile die Spaltenzahl von 16 auf 4 anpasst, hast du auch Namen welche bereits eine Schicht ausfüllen aus der DD-Liste ausgeschlossen.

For Each rZelle In rDaten.Cells
            For j = 16 To 33 'P:AG

Da du aber gemeint hast dass eventuell MA aufgrund der Bereitschaft mehrfach auftreten können, solltest du das Makro so lassen wie es ist.
lg Matthias

Bild

Betrifft: AW: nachgefragt ...
von: JensK
Geschrieben am: 28.10.2015 08:32:03
Hallo Matthias,
ich bin platt. Vielen Dank! Ich hoffe ich komme heute gleich dazu das mal zu testen.
Bis dahin
Jens

Bild

Betrifft: AW: nachgefragt ...
von: JensK
Geschrieben am: 28.10.2015 08:32:44
rggghh, wieder auf aktiv gesetzt ...

Bild

Betrifft: AW: nachgefragt ...
von: JensK
Geschrieben am: 28.10.2015 08:58:44
Hallo Matthias,
ich war zu neugierig und habe es gleich getestet - Respekt! Funktioniert einwandfrei. Bin gerade dabei mich in den Code einzulesen. Vom Ansatz her war ich da nicht so weit weg, aber die Umsetzung hätte wohl deutlich länger gedauert. Und die dynamischen Arrays sind genial.
Vielen Dank!!!! Das Forum hat mir schon öfter gut helfen können, nun habe ich auch mal selbst die direkte Erfahrung machen dürfen :)
Danke und weiter so.
Siehst du noch eine Möglichkeit die Teams zu berücksichtigen? Das wäre dann noch eine weitere Ebene vermute ich. Wir wollen die Kirche im Dorf lassen, wenn aber noch jemand eine Herausforderung sucht werfe ich das nochmal in den Ring.
lg Jens

Bild

Betrifft: AW: nachgefragt ...
von: matthias
Geschrieben am: 28.10.2015 10:29:08
Hallo Jens,
sicher geht das, die Frage ist nur: Wie?
Im Abschnitt "'Für jede Zeile Datenüberprüfung setzen" gehe ich für jeden eingetragenen Namen die Zeile im Schichtplan durch. Füge dort diesen Code-Abschnitt ein und ersetze den alten:

    For i = fRow(LBound(fRow) + 1) To fRow(UBound(fRow))
        ReDim fDaten(0)
        For Each rZelle In rDaten.Cells
            For j = 16 To 33 'P:AG
                If Left(Cells(i, j), 5) = "Team " Then 'Team erkannt
                    If Right(Cells(i, j), Len(Cells(i, j)) - 5) = rZelle.Offset(0, 4) _
                    Then GoTo NextrZelle2
                Else
                    If rZelle = Cells(i, j) Then GoTo NextrZelle2
                End If
            Next j
            ReDim Preserve fDaten(UBound(fDaten) + 1)
            fDaten(UBound(fDaten)) = rZelle
NextrZelle2:
        Next rZelle

Eine zusätzliche Wenn-Bedingung fragt nun ab, ob eine der Zellen mit "Team " beginnt. Wenn nein (Else), wird das gleiche gemacht wie bisher. Falls doch, wird geprüft ob der eingetragene Name zu diesem Team gehört, wenn ja wird der Name nicht ins Datenfeld fDaten aufgenommen.
Das blöde nur, die Namen "Team Köln" und "Team Offenburg" gehören zu keinem Team und verbleiben daher in der Dropdown. Um dies zu vermeiden weise denen im Sheet "Daten" noch ein Team zu ;)
Das mit den Kunden muss ich mir noch näher anschauen, das wird auf die Schnelle nichts.
lg Matthias

Bild

Betrifft: AW: nachgefragt ...
von: matthias
Geschrieben am: 28.10.2015 12:03:19
Okay,
das ging doch einfacher wie gedacht, wie du siehst sind nicht viele Änderungen notwendig gewesen:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rZelle As Range, rDaten As Range
Dim fRow() As Long, fDaten()
Dim i As Long, j As Long, lSpalte As Long
Dim sFormula As String
'Eingabebereich = "Abwesend"
If Not Intersect(Target, Range("P:AG")) Is Nothing Then
    
    With Sheets("Daten") 'Liste der Namen
        Set rDaten = .Range("D2:D" & .Cells(.Rows.Count, 4).End(xlUp).Row)
    End With
    
    'Bestimmung betroffener Zeilen
    ReDim fRow(0)
    For Each rZelle In Intersect(Target, Range("P:AG")).Cells
        For i = LBound(fRow) To UBound(fRow)
            If rZelle.Row = fRow(i) Then GoTo NextrZelle1
        Next i
        'Zeilen merken
        If rZelle.Row > 3 Then
            ReDim Preserve fRow(UBound(fRow) + 1)
            fRow(UBound(fRow)) = rZelle.Row
        End If
        If UBound(fRow) < 1 Then Exit Sub 'nur Kopfzeilen
NextrZelle1:
    Next rZelle
    
    For lSpalte = 1 To 4 'Kunden 1=A / 2=B / 3=C / 4=Abwesend
        'Für jede Zeile Datenüberprüfung setzen
        For i = fRow(LBound(fRow) + 1) To fRow(UBound(fRow))
            ReDim fDaten(0)
            For Each rZelle In rDaten.Cells
                If lSpalte < 4 Then 'Kunden A bis C
                    If rZelle.Offset(0, lSpalte) <> "x" Then GoTo NextrZelle2  'kein "x"
                End If
                For j = 16 To 33 'P:AG
                    If Left(Cells(i, j), 5) = "Team " Then 'Team erkannt
                        If Right(Cells(i, j), Len(Cells(i, j)) - 5) = rZelle.Offset(0, 4) _
                        Then GoTo NextrZelle2
                    Else
                        If rZelle = Cells(i, j) Then GoTo NextrZelle2
                    End If
                Next j
                ReDim Preserve fDaten(UBound(fDaten) + 1)
                fDaten(UBound(fDaten)) = rZelle
NextrZelle2:
            Next rZelle
            
            If UBound(fDaten) < 1 Then
                sFormula = " - "
                GoTo ListeSetzen
            End If
            
            'Inhalt der Liste bestimmen
            For j = LBound(fDaten) + 1 To UBound(fDaten)
                If j = 1 Then
                    sFormula = CStr(fDaten(j))
                Else
                    sFormula = sFormula & "," & CStr(fDaten(j))
                End If
            Next j
            
ListeSetzen:
            'Liste der DÜ setzen
            If lSpalte = 4 Then
                Set rZelle = Range(Cells(i, 16), Cells(i, 33)) 'Validation-Range
            Else
                Set rZelle = Union(Cells(i, lSpalte + 3), _
                                    Cells(i, lSpalte + 7), _
                                    Cells(i, lSpalte + 11))
            End If
            With rZelle.Validation
                .Delete
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
                Operator:=xlBetween, Formula1:=sFormula
                .IgnoreBlank = True
                .InCellDropdown = True
                .InputTitle = ""
                .ErrorTitle = ""
                .InputMessage = ""
                .ErrorMessage = ""
                .ShowInput = True
                .ShowError = True
            End With
        Next i
    Next lSpalte
End If
End Sub
Im Grunde wird nun für jeden Kunden (A bis C) das Datenfeld neu gefüllt und die Datenüberprüfung in der entsprechenden Spalte gesetzt. Das ganze noch ein viertes Mal für den "Bereich Abwesend".
Ist die Datenzelle ein Kunde (lSpalte <4), so wird geprüft ob ein "x" in der Spalte daneben steht, wenn nicht wird die Zelle nicht ins Datenfeld aufgenommen.
Der zweite wichtige Unterschied ist, dass beim setzen der Überprüfung die Range gewählt wird, je nach Kunde/Bereich "Abwesend" und damit nur für diese Spalten gültig wird.
Eine kleine Sache wäre da noch, falls das Datenfeld nun leer sein sollte, weil zuviele abwesend sind (Bsp. beide Teams abwesend und damit für Kunde B keiner zuständig), wird als Formel " - " ausgegeben. Ohne dies würde bei einem leeren Datenfeld die Formel nicht neu berechnet und die sFormula vom vorangegangenen Kunden genommen, was ja nicht erwünscht ist.
Natürlich stimmt deine Dropdown nur wenn du einmal etwas in dem Feld auswählst, denn sonst gilt noch die alte Datenüberprüfung. Dazu einfach in der obersten Zeile einen Namen auf abwesend stellen und diesen nach unten ziehen. Dabei kommt dir zugute dass du eine bedingte Formatierung genutzt hast, wodurch die Farben nicht mitgezogen werden. Anschließend den Namen wieder überall rauslöschen. Er rattert zwar kurz, aber das kommt daher dass es A viele Zeilen sind und B das Makro echt viele Schleifen für deine kleine Spielerei besitzt.
lg Matthias

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Dynamische Auswahlliste (dropdown) für Schichtplan"