Schichtplan erstellen

Hallo Excelfreunde
ich hoffe mir kann bei der Durchführung einer Arbeit geholfen werden.
Ich habe hier eine Datei vorliegen die als Schichtplan dienen soll.
In dem Blatt "Datenquelle" liegen Kürzel für die Gruppen 7635 und 7636 vor.
Diese kürzel bedeuten zB AF=A-Schicht/Früh, AS= A-Schicht/Spät, AN=A-Schiicht/Nacht, b, c, d, e =dito.
XX=Keine Produktion, UF=Urlaub/Frühschicht usw.
Ein Beispiel was gemacht werden soll: Nur Für Gruppe 7635 Bereich C bis L
Heute ist der 18.10.06 in Zeile 294
frühschicht:
Es sollen Zellen C294 bis L294 durchsucht werden ob hier AF, BF, CF, DF oder EF steht.
Wenn ja, dann soll in Zelle BP294 ein P geschrieben werden.
Wenn nicht, es steht XX oder UF dann soll in Zelle BP294 ein X eingetragen werden.
Spätschicht:
Es sollen Zellen C294 bis L294 durchsucht werden ob hier AS, BS, CS, DS oder ES steht.
Wenn ja, dann soll in Zelle BP295 ein P geschrieben werden.
Wenn nicht, es steht XX oder US dann soll in Zelle BP295 ein X eingetragen werden.
Nachtschicht:
Es sollen Zellen C294 bis L294 durchsucht werden ob hier AN, BN, CN, DN oder EN steht.
Wenn ja, dann soll in Zelle BP296 ein P geschrieben werden.
Wenn nicht, es steht XX oder UN dann soll in Zelle BP296 ein X eingetragen werden.
Diese Prozedur soll Montag bis Sonntag für das ganze Jahr gültig sein.
Kurz mit einfachen Worten:
Heute ist der 18 Mittwoch. Die Früh, Spät und Nachtschicht ist da. Dann steht bei Mittwoch im Bereich BL299 bis BU312 auf Früh, Spät und nachtschicht ein P.
Morgen ist der 19 Donnerstag. Die Früh und Spätschicht ist da. Die Nachtschicht hat Urlaub (UN). Es steht bei BQ296 ein X
20ter Freitag. Früh und Nacht sind da. Spät hat frei (US). Es steht bei BR295 ein X
Ist es möglich das zu automatisieren.
Der bereich C bis L wird laufend von mir geändert und soll im Bereich BN bis BT bei vorhander Schicht ein P und bei fehlender Schicht ein X schreiben.
Der Bereich AD bis AM (Gruppe 7636) soll den Bereich BX bis CD bestücken.
Ich hoffe das das so möglich ist.
Gruß Peter
https://www.herber.de/bbs/user/37491.zip

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Schichtplan erstellen

19.10.2006 15:54:06

fcs

Danke dir

19.10.2006 19:07:11

Peter

Hallo Peter,
folgende Makros setzen bei Änderungen in Spalten C bis L bzw. AD bis AM den Produktionsstatus der entsprechenden Schicht in den anderen Spalten. Damit der Prüfalgorithmus nicht zu kompliziert werden bei Änderungen in einer Zeile immer die Markierungen für alle 3 Schichten geprüft/neu berechnet.
Die Makros muß du im VBA-Editor unter der Tabelle "U7635+7636" einfügen.
Wie an den vielen If und Select Case Anweisungen zu sehen, ist es relativ kopliziert die Informationen korrekt aufzulösen.
Gruß
Franz
P.S.: Das Problem mit dem komprimierten Diagramm ist auch schon fast gelöst, da schau ich heute Abend noch mal rein.


Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zelle As Range, Tagesdaten As Range, FSN As Range
'Schichtinfo Gruppe 7635 markieren
If Target.Column >= 3 And Target.Column <= 12 And Target.Row >= 4 And Target.Row <= 375 Then
For Each Zelle In Target
Set Tagesdaten = Me.Cells(Zelle.Row, 3).Range("A1:J1") 'Bereich mit Schichtinformationen
'Bereich für Früh-, Spät-, Nachtschichtmarkierung gemäß Wochentag setzen
Select Case Weekday(Me.Cells(Zelle.Row, 2), vbMonday)
Case 1 'Mo
Set FSN = Me.Cells(Zelle.Row, "BN").Offset(2, 0).Range("A1:A3")
Case 2 'Di
Set FSN = Me.Cells(Zelle.Row, "BN").Offset(1, 1).Range("A1:A3")
Case 3 'Mi
Set FSN = Me.Cells(Zelle.Row, "BN").Offset(0, 2).Range("A1:A3")
Case 4 'Do
Set FSN = Me.Cells(Zelle.Row, "BN").Offset(-1, 3).Range("A1:A3")
Case 5 'Fr
Set FSN = Me.Cells(Zelle.Row, "BN").Offset(-2, 4).Range("A1:A3")
Case 6 'Sa
Set FSN = Me.Cells(Zelle.Row, "BN").Offset(-3, 5).Range("A1:A3")
Case 7 'So
Set FSN = Me.Cells(Zelle.Row, "BN").Offset(-4, 6).Range("A1:A3")
Case Else
'do nothing
GoTo Nexte1
End Select
Call Markieren(Tagesdaten, FSN, "Frühschicht", 1)
Call Markieren(Tagesdaten, FSN, "Spätschicht", 2)
Call Markieren(Tagesdaten, FSN, "Nachtschicht", 3)
Nexte1:
Next Zelle
End If
'Schichtinfo Gruppe 7636 markieren
If Target.Column >= 30 And Target.Column <= 39 And Target.Row >= 4 And Target.Row <= 375 Then
For Each Zelle In Target
Set Tagesdaten = Me.Cells(Zelle.Row, 30).Range("A1:J1") 'Bereich mit Schichtinformationen
'Bereich für Früh-, Spät-, Nachtschichtmarkierung gemäß Wochentag setzen
Select Case Weekday(Me.Cells(Zelle.Row, 2), vbMonday)
Case 1 'Mo
Set FSN = Me.Cells(Zelle.Row, "BX").Offset(2, 0).Range("A1:A3")
Case 2 'Di
Set FSN = Me.Cells(Zelle.Row, "BX").Offset(1, 1).Range("A1:A3")
Case 3 'Mi
Set FSN = Me.Cells(Zelle.Row, "BX").Offset(0, 2).Range("A1:A3")
Case 4 'Do
Set FSN = Me.Cells(Zelle.Row, "BX").Offset(-1, 3).Range("A1:A3")
Case 5 'Fr
Set FSN = Me.Cells(Zelle.Row, "BX").Offset(-2, 4).Range("A1:A3")
Case 6 'Sa
Set FSN = Me.Cells(Zelle.Row, "BX").Offset(-3, 5).Range("A1:A3")
Case 7 'So
Set FSN = Me.Cells(Zelle.Row, "BX").Offset(-4, 6).Range("A1:A3")
Case Else
'do nothing
GoTo Nexte2
End Select
Call Markieren(Tagesdaten, FSN, "Frühschicht", 1)
Call Markieren(Tagesdaten, FSN, "Spätschicht", 2)
Call Markieren(Tagesdaten, FSN, "Nachtschicht", 3)
Nexte2:
Next Zelle
End If
End Sub
Private Sub Markieren(Schichtinfo As Range, Markierung As Range, strSchicht As String, Zeile As Integer)
Dim rngSchicht As Range, Ueberschreiben As Boolean
Application.EnableEvents = False
'Schicht markieren
Select Case Markierung(Zeile, 1)
Case "P", "X", "?", ""
Ueberschreiben = True
Case Else
If MsgBox("Markierung enthält besonderen Eintrag: " & Markierung(Zeile, 1) & "   für " & strSchicht & " am " _
& Me.Cells(Schichtinfo.Row, 2) _
& vbLf & vbLf & "Markierung überschreiben?", vbYesNo, "Schicht Markieren") = vbYes Then
Ueberschreiben = True
Else
Ueberschreiben = False
End If
End Select
If Ueberschreiben = True Then
Set rngSchicht = Schichtinfo.Find(What:=Left(strSchicht, 1))
If rngSchicht Is Nothing Then
MsgBox Left(strSchicht, 1) & " für " & strSchicht & " nicht gefunden für " & Me.Cells(Schichtinfo.Row, 2)
Markierung(Zeile, 1) = "?"
Else
Select Case rngSchicht.Offset(0, -1).Value
Case "A", "B", "C", "D", "E" 'Produktion
Markierung(Zeile, 1) = "P"
Case "U" 'Urlaub
Markierung(Zeile, 1) = "X"
Case Else 'Sonstiges
Markierung(Zeile, 1) = "?"
End Select
End If
End If
Application.EnableEvents = True
End Sub

Beliebteste Forumthreads (12 Monate)

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread