Hallo Gast
Fast…. Haben 07:00 und 08:00 beide einen Überlauf, dann fängt 0915 nicht am richtigen Ort weiter
Ich habe noch ein Fall entdeckt der noch nicht 100%ig ist. Wenn nämlich die letzte Aktion in einer Aktionszeit auf eine unmittelbar nachfolgende Nichtverfügbarkeit trifft:
-07:00 10 Piloten
-bis auf den letzten Kollegen (Nr 10 mit x) alle verfügbar
-9 Aktionen sind um 07:00 zu vergeben die natürlich an Kollege 1-9 gehen. Da Kollege 10 um 07:00 nicht verfügbar ist und aber gleichzeitig auch keine Aktion erhalten hat, muss um 08:00 Kollege 1 wieder die erste Aktion erhalten.
Im beschriebenen Fall kriegt im Moment Kollege 10 um 08:00 die erste Aktion, was nicht korrekt ist. Wenn ein Kollege nicht verfügbar ist, dann zählt dies wie er eine Aktion erhalten hätte.
Gruss Enzo
Hallo Enzo,
die Forensoftware stellt sicher noch eine kleinere Schrift, als du sie verwendest, zur Verfügung.
Hallo an Enzo + Kollegen
ich habe noch mal eine xlsx Datei hochgeladen damit Kollegen sie auch testen können. Für die Uhrzeit 9:15 sind in rot weitere Daten eingetragen um den Fehler nach Überlauf heraus zu finden. Es ist mir nicht gelungen.
@Enzo Vielleicht übersehe ich etwas?? Wenn der Fehler wirklich exisitiert am besten mir deine Originaldaten senden die ihn verursachen. Dann kann ich ihn leichter erkennen. Mein Versuch es selbst zu simulieren brachte mit den Daten im Beispiel keinen Fehler!
mfg Gast 123
Hallo Gast
BSP1 und 2 im Anhang.
Bsp1:
0700 habe ich 9 Aktionen und Marc als 10er kriegt A-kein Aktion da letzter, und B hat er sich per Zufall für 0700 auch noch ausgetragen. Da nicht verfügbar wie eine Aktion gilt, müsste um 0800 somit Martin das Schwimmen zugeteilt werden
Bsp2:
0700 und 0800 haben einen Überlauf da bis zu diesem Zeitpunkt jeder Kollege der eine Aktion erhalten sollte, eine bekommen hat. Nun soll am 0915 Martin wieder als Erster eine Aktion erhalten, da bis jetzt (0700 und 0800) ja alle eine Aktion erhalten haben
Hoffe das Hilft
Griss Enzo
Hallo Enzo
bitte unteren Codeteil in Modul1 und im Code für Tabelle Spielplan wechseln. Damit bekam ich beide Beispiele ans laufen. Toi, toi, toi ...
mfg Gast 123
Code:
If ü + 1 < lzB Then
'Verfügbarkeit prüfen (auf Nullwerte prüfen!!)
For j = 2 To lzF
If Trim(.Cells(j, 6)) = Empty Then Exit For
If Abs(AC.Value - .Cells(j, 6)) < 0.0001 Then _
If .Cells(a, 2) = .Cells(j, 7) Then a = a + 1
If a > lzB Then a = 2
Next j
'Kollegen Überlauf Prüfung bei Nicht Verfügbar!!
If InStr(Txt, .Cells(a, 2)) Then GoTo übL
'Kollegen in Spalte K eintragen
AC.Offset(0, 4) = .Cells(a, 2)
Txt = Txt & ", " & .Cells(a, 2)
a = a + 1 'Next Kollege in K
If a > lzB Then a = 2
ü = ü + 1 'Überlauf Zaehler +1
Else 'Überlauf Vorgabe Zeile 21:
übL: .Cells(21, "O") = "Überlauf:"
ü = ZÜberlauf
End If
Next AC
Cool Danke
Beispiel 2 geht nun einwandfrei
Beispiel 1 leider noch nicht
Herzlichen Dank an Gast 123. Cool wie das Teil jetzt funktioniert. Wir lieben es
Gruss Enzo
Hallo Enzo
du hattest Recht, im Beispiel 2 war noch ein Fehler. Tausche bitte mal diesen Codeteil in beiden Dateien aus. Dann sollte es klappen.
Danach mache ich drei Luftsprünge wenn das klappt!!!
mfg Gast 123
Code:
If ü + 1 < lzB Then
y = Empty 'a retten beim Kollegen Überlauf
'Verfügbarkeit prüfen (auf Nullwerte prüfen!!)
For j = 2 To lzF
If Trim(.Cells(j, 6)) = Empty Then Exit For
If Abs(AC.Value - .Cells(j, 6)) < 0.0001 Then
If .Cells(a, 2) = .Cells(j, 7) Then y = a: a = a + 1
If a > lzB Then a = 2
End If
Next j
'Kollegen Überlauf Prüfung bei Nicht Verfügbar!!
If InStr(Txt, .Cells(a, 2)) Then a = y: GoTo übL
Danke, geht aber leider noch nicht. Hab dir die Datei mit dem angepassten Code nochmals im Anhang
Gruss Enzo
Hallo Enzo
es war gut das du mir die letzte Datei geschickt hast, aus der Ferne war dieser Fehler NICHT zu finden! Dabei ist er sooo simpel!
Das Makro versagte, weil in der Verfügbarkeitsliste Leerzellen
(aus Formeln?) drin waren. Optisch nicht sichtbar war die LastZell zum Auswerten dann auch falsch! Um das Problem zu umgehen habe ich die Koper Routine auf For Next Schleife geaendert. Bitte diesen Teil noch im Code austauschen.
Bin gespannt ob es dann einwandfrei klappt ....
mfg Gast 123
Code:
EFS.Range("H2", EFS.[h2].End(xlDown)).Copy
.Range("D2").PasteSpecial xlPasteValues 'definierte Zeiten
EFS.Range("J2", EFS.[k2].End(xlDown)).Copy
.Range("A2").PasteSpecial xlPasteValues 'Kolegen Liste 1-15
' EFS.Range("M2", EFS.[n2].End(xlDown)).Copy '## kann gelöscht werden!
' .Range("F2").PasteSpecial xlPasteValues 'Ausnahmen (nicht verfügbar)
'Ausnahmen -Ohne Leerzellen- kopieren !!
For j = 2 To EFS.Range("M1").End(xlDown).Row
If Trim(EFS.Cells(j, "M")) = Empty Then Exit For
.Cells(j, "F") = EFS.Cells(j, "M")
.Cells(j, "G") = EFS.Cells(j, "N")
Next j
Application.CutCopyMode = False
'** Ende Kopier Teil: Daten in Spielplan kopieren
Nachtrag
ich empfhele im Makro auch diesen Teil für LastZell zu finden auf Spalte 2 (B) zu erhöhen, um das kopieren von Leerzellen zu vermeiden! In A steht die Lauf-Nr!!
'Daten aus Erfassung in Spielplan kopieren (keine Formeln!)
lzEf = EFS.Cells(Rows.Count, 2).End(xlUp).Row
EFS.Range("B2:B" & lzEf).Copy
.Range("J2").PasteSpecial xlPasteValues 'Aktionen
mfg Gast 123