Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1392to1396
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Schichtplan zusammenführen

Schichtplan zusammenführen
14.11.2014 03:30:50
Tobias
Guten Tag,
ich habe ein Problem mit Excel, bissher konnte ich mir immer selber Helfen oder habe google dazu missbraucht. Hat auch ziemlich viel gebracht und bissher stand mir noch nie was im weg. Habe mir Excel VBA selber bei gebracht, stoße aber jetzt an meine "Zeitlichen" grenzen. Ich bräuchte die Datei nämlich dringend.
Ich habe einen Schichtplan erstellt, der auf der einen Seite eine "Druckversion" hat und auf der anderen einen Urlaubsplan. Wenn man in dem Urlaubsplan bei dem Mitarbeiter ein "x" setzt wird dieser auf der Durckversion "Rot" markiert. Das funktioniert auch alles schon soweit. Nur fügt er die Namen nicht so zusammen wie ich das will. Zurzeit lass ich ihn über Loops die Farben auslesen und dann den Namen in die Übersicht schreiben. Nur sind die Namen nicht immer in der Selben Zeile, so wie es auf der Urlaubsseite gegliedert ist. Startet einfach die "FillUpSub" Function (Damit es nicht Sicherbar ist eine Function ...) und ihr seht wie es sich auf dem "Schichtplan" Tabellen Blatt zusammenführt. Aber wie gesagt, die Namen stehen nicht immer in der selben Reihe und das macht es unübersichtlich. Ich hätte es gerne wie auf der "Urlaubsplan" Tabelle.
Theoretisch genauso nur mit anderem Template und mit Namen anstatt Farben wenn ihr versteht ... Bitte um HILFE :(
Anhang: https://www.herber.de/bbs/user/93762.xlsm
MFG
Tobias

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Schichtplan zusammenführen
14.11.2014 22:13:59
Dieter
Hallo Tobias,
wenn ich dein Problem richtig verstanden habe, dann kannst du das mit dem folgenden Programm machen:
Sub FillUpSubNeu()
Dim anfZeileKW As Long
Dim anzKW As Long
Dim bereichKW As Range
Dim endZeileKW As Long
Const indFrühschicht As Long = 40
Const indNachtschicht As Long = 15
Const indSpätschicht As Long = 37
Dim k As Long
Dim letzteSpalteU As Long
Dim lfdJahr As Long
Dim m As Long
Dim s As Long
Dim spalteKW As Long
Dim spalteS As Long
Dim spalteU As Long
Dim t As Long
Dim wsS As Worksheet
Dim wsU As Worksheet
Dim zeileS As Long
Dim zeileU As Long
Set wsS = ThisWorkbook.Worksheets("Schichtplan")
Set wsU = ThisWorkbook.Worksheets("Urlaubsplan")
' Anzahl der vorhandenen Kalenderwochen des lfd. Jahres bestimmen
lfdJahr = Year(Date)
letzteSpalteU = wsU.Cells(2, wsU.Columns.Count).End(xlToLeft).Column
For spalteU = 3 To letzteSpalteU Step 7
If Year(wsU.Cells(4, spalteU)) > lfdJahr Then
anzKW = (spalteU - 10) / 7 + 1
Exit For
End If
Next spalteU
For k = 1 To anzKW
anfZeileKW = (k - 1) * 16 + 4
endZeileKW = anfZeileKW + 11
Set bereichKW = wsS.Range(wsS.Cells(anfZeileKW, "B"), _
wsS.Cells(endZeileKW, "H"))
bereichKW.ClearContents
spalteKW = (k - 1) * 7 + 3
For t = 0 To 6 ' t läuft über die Tage einer KW
spalteU = spalteKW + t
For s = 0 To 2 ' s läuft über die 3 Schichtblöcke
For m = 0 To 3 ' m läuft über die 4 Mitarbeiter eines Schichtblocks
zeileU = 6 + 4 * s + m
Select Case wsU.Cells(zeileU, spalteU).Interior.ColorIndex
Case indFrühschicht
zeileS = anfZeileKW + m
Case indSpätschicht
zeileS = anfZeileKW + 4 + m
Case indNachtschicht
zeileS = anfZeileKW + 8 + m
Case Else
zeileS = 0
End Select
If zeileS  0 Then
wsS.Cells(zeileS, t + 2) = wsU.Cells(zeileU, "B")
End If
Next m
Next s
Next t
Next k
End Sub
Viele Grüße
Dieter

Anzeige
AW: Schichtplan zusammenführen
18.11.2014 20:10:28
silencshadow
Hallo,
prinzipiell ist alles richtig gelöst und ich bedanke mich schon einmal im voraus! Habe aber dennoch eine kleine Frage an dich für eine Code Anpassung.
Habe mir den Code jetzt so umgeschrieben das er im Urlaubsplan alle mit "x" markierten Einträge Rot markiert, aber bin dennoch nicht ganz fertig und da brauche ich wieder deine Hilfe.
Erstmal mein veränderter Code:
Sub FillUpSubNeu()
Dim anfZeileKW As Long
Dim anzKW As Long
Dim bereichKW As Range
Dim endZeileKW As Long
Const indFrühschicht As Long = 40
Const indNachtschicht As Long = 15
Const indSpätschicht As Long = 37
Dim k As Long
Dim letzteSpalteU As Long
Dim lfdJahr As Long
Dim m As Long
Dim s As Long
Dim spalteKW As Long
Dim spalteS As Long
Dim spalteU As Long
Dim t As Long
Dim wsS As Worksheet
Dim wsU As Worksheet
Dim zeileS As Long
Dim zeileU As Long
Set wsS = ThisWorkbook.Worksheets("Schichtplan")
Set wsU = ThisWorkbook.Worksheets("Urlaubsplan")
'wsS.Unprotect "1234"
' Anzahl der vorhandenen Kalenderwochen des lfd. Jahres bestimmen
lfdJahr = Year(Date)
letzteSpalteU = wsU.Cells(2, wsU.Columns.Count).End(xlToLeft).Column
For spalteU = 3 To letzteSpalteU Step 7
If Year(wsU.Cells(4, spalteU)) > lfdJahr Then
anzKW = (spalteU - 10) / 7 + 1
Exit For
End If
Next spalteU
anzKW = 6 ' Anzahl auf 6 KW's Reduziert
For k = 1 To anzKW
anfZeileKW = (k - 1) * 16 + 4
endZeileKW = anfZeileKW + 11
Set bereichKW = wsS.Range(wsS.Cells(anfZeileKW, "B"), _
wsS.Cells(endZeileKW, "H"))
bereichKW.ClearContents
spalteKW = (k - 1) * 7 + 3
For t = 0 To 6 ' t läuft über die Tage einer KW
spalteU = spalteKW + t
For s = 0 To 2 ' s läuft über die 3 Schichtblöcke
For m = 0 To 3 ' m läuft über die 4 Mitarbeiter eines Schichtblocks
zeileU = 6 + 4 * s + m
Select Case wsU.Cells(zeileU, spalteU).Interior.ColorIndex
Case indFrühschicht
zeileS = anfZeileKW + m
Case indSpätschicht
zeileS = anfZeileKW + 4 + m
Case indNachtschicht
zeileS = anfZeileKW + 8 + m
Case Else
zeileS = 0
End Select
If zeileS  0 Then
wsS.Cells(zeileS, t + 2) = wsU.Cells(zeileU, "B")
If wsU.Cells(zeileU, spalteKW + t).Value = "x" Then
wsS.Cells(zeileS, t + 2).Font.Color = "-16776961"
Else
wsS.Cells(zeileS, t + 2).Font.ColorIndex = xlAutomatic
End If
End If
Next m
Next s
Next t
Next k
'wsS.Protect "1234"
End Sub
Habe dazu aber noch eine Frage, kannst du mir den Code so ändern das er nur fortlaufend die nächsten 6 Wochen hin schreibt, also von HEUTE (KW 47) bis KW in 6 Wochen also KW 52 .. nächste Woche von KW 48 bis KW 53 etc. und irgendwie das der Code erkennt welche Woche zur Zeit ist und halt die Nächsten 6 Wochen ausrechnet und in den Schichtplan schreibt, so das immer nur 6 Wochen angezeigt werden, von der jetzigen KW. Zurzeit rechnet er mir die Jetzige Woche um eine verschoben, oder er schreibt sie falsch vom Urlaubsplan rüber. Also KW 47 ist bei ihm KW 48. Habe die Datei ja angefügt, kannst es dir ja da noch einmal anschauen. Am besten so, das ich mir die Anzahl der KW's bestimmen kann und ggf. auch wann er beginnt, also einmal eine Variable für "Jetzige KW" und eine für "KWStart = 23/2014" oder so. Also das das Modul auch für nächstes Jahr nahtlos funktioniert, will mir jede Woche einen neuen Plan drucken, dieser muss aber jedes mal neu generieren.

Anzeige
AW: Schichtplan zusammenführen
18.11.2014 22:23:33
silencshadow
Edit:
Habe leider kein Edit Knopf gefunden deswegen mach ich es so,
es wäre auch ganz nett wenn man irgendwie einstellen könnte wie viele Mitarbeiter genommen werden sollen, es kann nämlich sein, das 2 Mitarbeiter dazu kommen, dann sind auf 2 Schichten 5 und auf 1ner 4. Ist das irgendwie machbar, oder muss man dann mit dem Mitarbeiter "Leer" arbeiten? Bitte deswegen um eine Weitere anpassung.
MfG

AW: Schichtplan zusammenführen
19.11.2014 13:06:13
silencshadow
Oh, glaube habe den Haken bezüglich der nicht beantworteten Frage vergessen, finde immer noch kein edit knopf! lol

AW: Schichtplan zusammenführen
19.11.2014 16:52:46
Dieter
Hallo silencshadow (bei der ersten Anfrage war dein Name noch Tobias),
offenbar kommt der Appetit mit dem Essen. Als kleine Übung mache ich dir das mit dem Anfang bei der aktuellen Woche, auf längere Sicht musst du selbst programmieren lernen.
Zu der variablen Mitarbeiterzahl müsstest du noch einmal ein Beispiel hochladen, in dem zu sehen ist, was du dir vorstelltst.
Hier also das neue Programm (mit fester Mitarbeiterzahl):
Sub FillUpSubNeu_2()
Dim anfKW As Long
Dim anfZeileKW As Long
Dim anzKW As Long
Dim bereichKW As Range
Dim endZeileKW As Long
Const indFrühschicht As Long = 40
Const indNachtschicht As Long = 15
Const indSpätschicht As Long = 37
Dim k As Long
Dim letzteSpalteU As Long
Dim lfdJahr As Long
Dim m As Long
Dim s As Long
Dim spalteAnfKW As Long
Dim spalteKW As Long
Dim spalteS As Long
Dim spalteU As Long
Dim t As Long
Dim wsS As Worksheet
Dim wsU As Worksheet
Dim zeileS As Long
Dim zeileU As Long
Set wsS = ThisWorkbook.Worksheets("Schichtplan")
Set wsU = ThisWorkbook.Worksheets("Urlaubsplan")
'wsS.Unprotect "1234"
' Anfangskalenderwoche
anfKW = KW_nach_DIN(Date)
lfdJahr = Year(Date)
letzteSpalteU = wsU.Cells(2, wsU.Columns.Count).End(xlToLeft).Column
For spalteU = 3 To letzteSpalteU Step 7
If CLng(Right$(wsU.Cells(2, spalteU), 2)) = anfKW And _
Year(wsU.Cells(4, spalteU)) = lfdJahr Then
spalteAnfKW = spalteU
Exit For
End If
Next spalteU
anzKW = 6 ' Anzahl auf 6 KW's Reduziert
For k = 1 To anzKW
anfZeileKW = (k - 1) * 16 + 4
endZeileKW = anfZeileKW + 11
Set bereichKW = wsS.Range(wsS.Cells(anfZeileKW, "B"), _
wsS.Cells(endZeileKW, "H"))
bereichKW.ClearContents
spalteKW = spalteAnfKW + (k - 1) * 7
For t = 0 To 6 ' t läuft über die Tage einer KW
spalteU = spalteKW + t
For s = 0 To 2 ' s läuft über die 3 Schichtblöcke
For m = 0 To 3 ' m läuft über die 4 Mitarbeiter eines Schichtblocks
zeileU = 6 + 4 * s + m
Select Case wsU.Cells(zeileU, spalteU).Interior.ColorIndex
Case indFrühschicht
zeileS = anfZeileKW + m
Case indSpätschicht
zeileS = anfZeileKW + 4 + m
Case indNachtschicht
zeileS = anfZeileKW + 8 + m
Case Else
zeileS = 0
End Select
If zeileS  0 Then
wsS.Cells(zeileS, t + 2) = wsU.Cells(zeileU, "B")
If wsU.Cells(zeileU, spalteKW + t).Value = "x" Then
wsS.Cells(zeileS, t + 2).Font.Color = "-16776961"
Else
wsS.Cells(zeileS, t + 2).Font.ColorIndex = xlAutomatic
End If
End If
Next m
Next s
Next t
Next k
'wsS.Protect "1234"
End Sub
Die Kalenderwoche nach europäischer Norm bekommst du mit der folgenden Funktion:
Function KW_nach_DIN(Datum As Date) As Long
'Berechnung der Kalenderwoche nach DIN 1355
Dim anfDatum As Date
anfDatum = DateSerial(Year(Datum + (8 - Weekday(Datum)) Mod 7 - 3), 1, 1)
KW_nach_DIN = (Datum - anfDatum - 3 + (Weekday(anfDatum) + 1) Mod 7) \ 7 + 1
End Function
Viele Grüße
Dieter
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige