VBA Serie in Rotationsplan automatisch

[Claus Thaler]

Hallo liebe Freunde,

ich bin dabei einen Rotationsplan zu erstellen, wo verschiedene Mitarbeiter in verschiedenen Bereichen eingesetzt werden sollen.

jetzt wollte ich eine Funktion hinzufügen, dass eine einzelne Person oder eine Gruppe von Personen an einem ausgewähltem Wochentag automatisch mit einem Bereich und dem Bereich von bis (Datum) eingefügt wird.

ich habe hier schon etwas vorbereitet.
schaut mal herein.

ich hoffe hier kann mir geholfen werden.

Danke und liebe grüße

[schauan]

Hallöchen,

hier mal ein Ansatz.
Für ein automatisches Ausfüllen sollte es einen Rhythmus geben. Dazu könnten die Kollegen festen „Schichtteams“ zugeordnet werden.
Bei einer Regel kann man die Schichten per Formel zuordnen und auf so einem Blatt irgendeinen Zeitraum darstellen.
Hier hab ich mal ein kleines Beispiel für ein 3-Schicht-System. Oben links in dem gelben Bereich habe ich ein Datum für die Frühschicht eines Teams an einen Montag eingetragen. Ausgehend von diesem Datum kannst Du für das Team auch ausrechnen, welche Schicht es an einem bestimmten Datum in 100 Jahren hat ? Ich hab mit den Abkürzungen F-S-N gearbeitet

Arbeitsblatt mit dem Namen 'Datenblatt' A B 1 Beginn Team1 am 2 26.12.2016 3 F 4 heute 5 Auswahl 19.02.2021 6 Team1 F 7 8 Team1 9 Team2 10 Team3
Zelle Formel B5 =HEUTE() B6 =TEIL("FNS";ABRUNDEN(REST((DATEDIF(Datenblatt!$A$2;B5+7*((--TEIL($A6;5;1)=1)+(--TEIL($A6;5;1)=2)*3+(--TEIL($A6;5;1)=3)*2-1);"d")+1)/7;3);0)+1;1)	Zelle Gültigkeitstyp Operator Wert1 Wert2 A6 Liste =$A$8:$A$10

Verwendete Systemkomponenten: [Windows (32-bit) NT 10.00] MS Excel 2016

Diese Tabelle wurde mit Tab2Html (v2.6.2) erstellt. ©Gerd alias Bamberg

[Claus Thaler]

Danke für deine Antwort,

eigentlich habe ich gedacht das es über ein VBA code läuft.
ich habe schon eine UserForm dafür erstellt.

ist es möglich das man es über die UserForm lösen kann?

Der Grund ist, da ich in die leeren Zeilen keine Formel rein schreiben kann, da dort eine liste zur Auswahl anderer aufgaben eingetragen werden kann.

[Claus Thaler]

Ist es möglich dies per VBA zu lösen?

[schauan]

Hallöchen,

ja, schauen wir mal. Bin nur gerade unterwegs, wird vielleicht heute Nachmittag oder Abend, falls nicht zwischendurch ein anderer die Aufgabe übernimmt ...

[schauan]

Hallöchen,

im Prinzip was in der Art. Das Startdatum könnte man ggf. mit FIND suchen, dann geht es etwas schneller.
Ich habe hier mal die Eintragung auf die aktive Zelle bezogen. Wenn Du den Mitarbeiter auf dem Blatt anklickst und nimmst, würdest Du Dir die Auswahl im Dialog sparen.

Code:

Private Sub CommandButton4_Click()
'Variablendeklaration
Dim icnt%
'Schleife ab Spalte 7 (G) bis zum Ende des ausgefüllten Bereichs der Zeile 9
For icnt = 7 To Cells(9, Columns.Count).End(xlToLeft).Column
  'Wenn das Datum der Zelle mit dem Datum der Box uebereinstimmt, dann
  If Cells(9, icnt).Value >= CDate(Box3.Value) Then
    'Wenn der Wochentag auf dem Blatt mit dem der Box uebereinstimmt, dann
    If Cells(10, icnt).Text = Box2.Value Then
      'Gewaehltes Kuerzel eintragen
      Cells(ActiveCell.Row, icnt).Value = Box5.Value
    'Ende Wenn der Wochentag auf dem Blatt mit dem der Box uebereinstimmt, dann
    End If
    'Wenn das Datum auf dem Blatt groesser als das gewaehlte ist, dann Schleife verlassen
    If Cells(9, icnt).Value > CDate(Box4.Value) Then Exit For
  'Ende Wenn das Datum der Zelle mit dem Datum der Box uebereinstimmt, dann
  End If
'Ende Schleife ab Spalte 7 (G) bis zum Ende des ausgefüllten Bereichs der Zeile 9
Next
End Sub

[Claus Thaler]

Vielen Vielen dank.

Genau so sollte es Funktionieren.


Aber könntest du mir trotzdem bei der FIND Funkrion weiter Helfen?
Ich bekomme das nicht so hin das aus der Box der Name gesucht und die Celle markiert wird.
Wenn das noch klappen könnte wäre das super.

Würde das auch für eine Mehrfachauswahl gehen?
Das ich z.B alle Mitarbeiter vom einem gleichen Beruf oder einem Lehrjahr mit einer Auswahl übernehmen kann?

Vielen dank.

Bis hier hin ist es schon echt super.

und durch die Kommentare auch super erklärt.
Ich freu mich so :)

[schauan]

Hallöchen,

schaue ich mir dann nochmal an. Bei Einfachauswahl würde FIND ausreichen, bei Mehrfachauswahl könnte man eventuell per Autofilter alles in einem Rutsch... Muss ich mal durchdenken.

[schauan]

Hallöchen,

hier ist erst mal die Änderung für einen Namen. Das Prinzip ist erst mal ähnlich. Diesmal aktiviert der Code die Zelle mit dem Namen. Kann man auch anders lösen, idem man bei Find die Zeile zieht und dann mit der Zeilennummer arbeitet.
Für eine Mehrfachauswahl müsste dann noch eine Schleife drum herum.

Code:

Private Sub CommandButton4_Click()
'Variablendeklaration
Dim icnt%

Sheets("Rotationsplan (2020-2021)").Columns(5).Find(What:=Box1.Value, After:=Cells(18, 5), LookIn:=xlValues _
        , LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate

'Schleife ab Spalte 7 (G) bis zum Ende des ausgefüllten Bereichs der Zeile 9
For icnt = 7 To Cells(9, Columns.Count).End(xlToLeft).Column
  'Wenn das Datum der Zelle mit dem Datum der Box uebereinstimmt, dann
  If Cells(9, icnt).Value >= CDate(Box3.Value) Then
    'Wenn der Wochentag auf dem Blatt mit dem der Box uebereinstimmt, dann
    If Cells(10, icnt).Text = Box2.Value Then
      'Gewaehltes Kuerzel eintragen
      Cells(ActiveCell.Row, icnt).Value = Box5.Value
    'Ende Wenn der Wochentag auf dem Blatt mit dem der Box uebereinstimmt, dann
    End If
    'Wenn das Datum auf dem Blatt groesser als das gewaehlte ist, dann Schleife verlassen
    If Cells(9, icnt).Value > CDate(Box4.Value) Then Exit For
  'Ende Wenn das Datum der Zelle mit dem Datum der Box uebereinstimmt, dann
  End If
'Ende Schleife ab Spalte 7 (G) bis zum Ende des ausgefüllten Bereichs der Zeile 9
Next
End Sub

[Claus Thaler]

vielen vielen Dank.

Genau so sollte es funktionieren.

Ich kann es zwar an meine Bedürfnisse anpassen aber die Schleife bekomm ich irgend wie nicht hin.

Könntest du mir dabei auch nochmal helfen?

Ich finde deine Programmierung echt super, auch mit den Kommentaren ist es sehr hilfreich.
Dadurch lerne ich echt viel.

Danke und liebe grüße