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

Schichtplan
29.11.2014 11:30:31
Tobias
Guten Tag,
habe damals in einem Thread (auf den ich nicht mehr antworten kann weil er im Archiv liegt, einfach nach "Schichtplan" suchen), folgenden Code bekommen.
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
Der Funktioniert auch einwandfrei und habe ihn mir auch angepasst, aber wenn in irgendeiner derzeit geöffneten Arbeitsmappe die Formel "=HEUTE()" enthalten ist, ist das ganze nur noch 1/3 so schnell wie vorher. Also die Formel "=HEUTE()" bremst den Code um ca 66% ein. Warum ist das so? Immerhin ist das "=HEUTE()" sogar in einer anderen Arbeitsmappe.
MfG

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Schichtplan
29.11.2014 11:32:27
Hajo_Zi
schalte die Berechnung aus. Hätte ich mal vermutetet.

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige