Hallo zusammen und schonmal danke im voraus für die Hilfe und Zeit,
ich arbeite derzeit an einer Datei welche automatisch Stundenpläne erstellt. Dabei stecke ich gerade fest weil ich einen Fehler nicht finde und hoffe das hier ein anderer Blickwinkel vielleicht helfen kann.
Die Datei hat unter anderem die Reiter "Semesterplanung" und "Wochenplanung". In der Semesterplanung stehen alle Kalenderwochen eines Semesters, alle Fächer und pro Woche 4 Spalten für Klassen. Wenn das Fach in der Woche bei der Klasse unterrichtet wird, steht in der entsprechenden Zelle wo sich die Klasse und das Fach kreuzen die Stundenzahl, in allen anderen Zellen der Spalte steht nichts. Auf dem Reiter Wochenplan sollen nun nur noch die Fächer eingetragen werden, die für die gerade relevante Woche akut sind. Dabei sollen erst die Fächer von Klasse 1 eingetragen werden, dann die von Klasse 2, 3 und 4 (nacheinander). Dabei sollen Fächer die bereits in einer der vorigen Klassen ebenfalls eingetragen sind in der gleichen Spalte auftauchen. Also wenn ein Fach in Klasse 1 und 3 unterrichtet wird, sollen beide in der gleichen Spalte stehen. Bei Klasse 2 darf in der Spalte dann nur ein Fach stehen das weder in 1 noch in 3 unterrichtet wird.
Ich habe dafür folgenden Code geschrieben (der erstmal nur Klasse 1 und 2 füllt), das Problem ist er trägt bei Klasse 2 schon nichts mehr ein und verliert sich in der Schleife wenn er die Zeile für Klasse 2 finden soll.
Sub Wochenplanung()
Dim Klasse As Integer
Dim Fach As String
Dim Stundenzahl As Integer
Dim Spalte As Integer
Dim Zeile As Integer
Dim Woche As Integer
Dim Wochenplanzeile As Integer
Dim Hörsaal As Integer
Dim Anzahl_Klasse As Integer
Dim Vorhanden As Integer
'Teil 1: Die Fächer für die Klassen ermitteln die in der Woche unterrichtet werden sollen
Hörsaal = 1 'Immer mit Klasse 1 beginnen
Anzahl_Klassen = Range("anzahl_klassen").Value
Spalte = 36 'Die Basis für die Berechnung der Spalte
'Die Spalte für Klasse 1 ermitteln
Woche = Range("aktuelle_woche").Value - 1 'Die aktuelle Woche bezieht sich auf die nächste, noch nicht geplante Woche im Semesterplaner
Spalte = Spalte + 8 * Woche 'Der Faktor 8 rührt daher das zwei Kalenderwochen in der Semesterplanung genau 8 Spalten auseinander liegen
Vorhanden = 0
'Auf den Reiter Semesterplanung wechseln
Application.ScreenUpdating = False
Sheets("Semesterplanung").Activate
'Zur Sicherheit alle Daten im Reiter Wochenplanung löschen
Sheets("Wochenplanung").Range("A4:H9").Value = ""
'Zuerst die nötigen Fächer zusammentragen
'Alle Fächer je nach Klasse zusammenstellen
Do Until Hörsaal > Anzahl_Klassen
Zeile = 6 'Die oberste Zeile in der Semesterplanung
Wochenplanzeile = 4 'Der erste Hörsaal wird von oben nach unten eingetragen
'Die folgende Sequenz durchlaufen bis zur letzten erlaubten Wochenplanungszeile oder dem letzten Fach (mehr als 100 Fächer sind im Semesterplan nicht vorgesehen)
Do Until Wochenplanzeile = 10 Or Wochenplanzeile = 3
'Die nächste Zeile mit Stundenzahl ermitteln
Do Until Cells(Zeile, Spalte).Value <> "" Or Zeile > 105
Zeile = Zeile + 1
Loop
'Das Fach aus der ermittelten Zeile speichern
Fach = Cells(Zeile, 7).Value
'Prüfen ob das Fach in einem der anderen Hörsäle schonmal eingetragen wurde, falls ja das Fach in die gleiche Zeile packen
'HIER passiert der Fehler, aus dieser Schleife kommt VBA nicht mehr raus. Zur Erklärung: Der Platz für Fächer ist limitiert auf die Zeilen 4-9.
If Hörsaal = 2 Then
Wochenplanzeile = 9
Do Until Sheets("Wochenplanung").Cells(Wochenplanzeile, 1).Value = Fach Or Wochenplanzeile = 3
Wochenplanzeile = Wochenplanzeile - 1
Loop
If Sheets("Wochenplanung").Cells(Wochenplanzeile, 1).Value = Fach Then
Vorhanden = 1
End If
End If
'Sofern das Fach noch nicht vorhanden war, die unterste leere Zeile wählen
If Vorhanden = 0 And Hörsaal > 1 Then
Wochenplanzeile = 9
Do Until Sheets("Wochenplanung").Cells(Wochenplanzeile, (Hörsaal * 2) - 1).Value = "" Or Wochenplanzeile = 3
Wochenplanzeile = Wochenplanzeile - 1
Loop
End If
'Das Fach speichern
Sheets("Wochenplanung").Cells(Wochenplanzeile, (Hörsaal * 2) - 1).Value = Fach
'Die Menge an Stunden speichern
Stundenzahl = Cells(Zeile, Spalte).Value
Sheets("Wochenplanung").Cells(Wochenplanzeile, Hörsaal * 2).Value = Stundenzahl / 2 'Durch 2 geteilt weil an der HSB immer Doppelstunden abgehalten werden
'Das nächste Fach in der Zeile darunter speichern wenn es sich um Hörsaal 1 handelt
If Hörsaal = 1 Then
Wochenplanzeile = Wochenplanzeile + 1
End If
'Mindestens eine Zeile im Semesterplan weiter gehen
Zeile = Zeile + 1
Loop
'Sofern weniger Stunden in dieser Woche enthalten sind als maximal möglich einen Dummy für die restlichen einfügen
If Sheets("Wochenplanung").Cells(10, 2 * Hörsaal).Value < Sheets("Semesterplanung").Cells(1, Spalte).Value / 2 Then
Sheets("Wochenplanung").Cells(9, 2 * Hörsaal).Value = 0
Sheets("Wochenplanung").Cells(9, (2 * Hörsaal) - 1).Value = "Dummy"
Sheets("Wochenplanung").Cells(9, 2 * Hörsaal).Value = (Sheets("Semesterplanung").Cells(1, Spalte).Value / 2) - Sheets("Wochenplanung").Cells(10, 2 * Hörsaal).Value
End If
'Zum nächsten Hörsaal wechseln
Hörsaal = Hörsaal + 1
'Die Spalte des nächsten Hörsaal im Semesterplan ist 2 Spalten weiter rechts
Spalte = Spalte + 2
Loop
'Sicherung falls keine Fächer eingetragen wurden
If Sheets("Wochenplanung").Cells(4, 1).Value = "" Then
Mldng = MsgBox("Es gibt keine Fächer für die Wochenplanung. Bitte erst die Semesterplanung abschließen", vbOKOnly, "Vorgangsfehler")
Exit Sub
End If
'Teil 2: Die Fächer mit dem Simplex-Algorithmus zuteilen
Call Stundenplan
'Zurück zum Reiter Wochenplanung wechseln
Sheets("Stundenpläne").Activate
Application.ScreenUpdating = True
End Sub
|