Hallo,
hier nun der Code:
Sub pruefestudi()
'-----Variablendeklarationen-----'
'--Variablen für die do-while-schleife:--'
'gibt an in welcher Zeile im Arbeitsblatt "wer kann wann" der Name des ersten Studenten steht
studispalte = 3
'gibt an in welcher Spalte im Arbeitsblatt "wer kann wann" der Name des ersten Studenten steht
studiname = 1
'studiname muss gefüllt sein damit die do-schleife beim ersten durchlauf losläuft
'--Variablen für die For-Schleifen:--'
Dim tagzaehler As Integer
tagzaehler = 1
Dim wochenzaehler As Integer
wochenzaehler = 1
Dim aspt As Integer
Dim azpt As Integer
Dim zabstand As Integer
Dim anzahltage As Integer
Dim spaltenzaehler As Integer
Dim sabstand As Integer
Dim tssv As Integer
Dim zeilenzaehler As Integer
'-- Sonstige Variablen--'
aspt = 6
' Anzahl Spalten pro Tag
azpt = 20
' Anzahl Zeilen pro Tag
zabstand = 5
' Abstand des ersten Feldes des eigentlichen Schichtplans vom oberen Rand in der Wochenblatt-Datei (Der eingetragene Wert ist die erste Zeile)
sabstand = 3
' Abstand des ersten Feldes des eigentlichen Schichtplans vom linken Rand in der Wochenblatt-Datei (Der eingetragene Wert ist die erste Spalte)
tagzeile = 2
' Die Zeile in der die Wochentage genannt werden
datumzeile = 1
' Die Zeile in der die Kalender-Daten genannt werden
schichtartzeile = 3
' Die Zeile in der die Art der Schicht genant wird
schichtkommentarzeile = 4
' Die Zeile für evtl. Kommentare zu der Schicht
uhrzeitspalte = 2
' Die Spalte in der die Uhrzeiten stehen
anzahltage = 5
' Die Anzahl der Tage pro Tabellenblatt, die geplant werden. 5 = Z.B: Mo-Fr. Wenn man auf den Blättern ein Feld für Samstag zurechtmacht und hier 6 eingträgt müsste es funktionieren
Dim anzahlstudis As Integer
anzahlstudis = 11
'Die Anzahl der Studis in der Liste
Dim studizaehler As Integer
' Für For-Schleife
'--Variablen für die Textausgabe--
Dim Datei As String, Text As String
Dim Zeile As Long
Dim zeigen
'-----Ende Variablendeklaration-----'
'----- Beginn 1. Block Textausgabe-----'
On Error GoTo Fehler
'Zieldatei festlegen
Datei = ThisWorkbook.Path & "\" & ThisWorkbook.Name & ".txt"
Open Datei For Output As #1 'Zieldatei öffnen
'----- Ende 1. Block Textausgabe-----'
For studizaehler = 1 To anzahlstudis
studiname = Workbooks(ThisWorkbook.Name).Worksheets("Wer kann wann").Cells(studizaehler, studispalte).Value
If studiname <> "" Then
Print #1, br
Print #1, "****" + studiname + "****", br
For wochenzaehler = 1 To 5
For tagzaehler = 1 To anzahltage
For spaltenzaehler = 1 To aspt
zellvergleicher = ""
For zeilenzaehler = 1 To azpt
tssv = (tagzaehler - 1) * aspt 'tagesstartspaltenverschieber verrückt das erste Feld, dasgeprüft wird, auf das erste Feld des jeweiligen Tages
zellvergleicher = Worksheets(wochenzaehler).Cells(zeilenzaehler + zabstand - 1, spaltenzaehler + sabstand + tssv - 1).Value
zellvergleichereinenweiter = Worksheets(wochenzaehler).Cells(zeilenzaehler + zabstand, spaltenzaehler + sabstand + tssv - 1).Value
zellvergleichereinenzurück = Worksheets(wochenzaehler).Cells(zeilenzaehler + zabstand - 2, spaltenzaehler + sabstand + tssv - 1).Value
If zellvergleicher = studiname Then
If zellvergleichereinenzurück <> studiname Then
schichtart = Worksheets(wochenzaehler).Cells(schichtartzeile, spaltenzaehler + sabstand + tssv - 1).Value
schichtkommentar = Worksheets(wochenzaehler).Cells(schichtkommentarzeile, spaltenzaehler + sabstand + tssv - 1).Value
schichtdatum = Worksheets(wochenzaehler).Cells(datumzeile, sabstand + tssv).Value
schichttag = Worksheets(wochenzaehler).Cells(tagzeile, sabstand + tssv).Value
schichtbeginn = Worksheets(wochenzaehler).Cells(zeilenzaehler + zabstand - 1, uhrzeitspalte).Value
Else
End If
If zellvergleichereinenweiter <> studiname Then
schichtende = Worksheets(wochenzaehler).Cells(zeilenzaehler + zabstand, uhrzeitspalte).Value
Print #1, br
Print #1, schichttag, schichtdatum, schichtart
If schichtkommentar <> "" Then
Print #1, schichtkommentar
End If
Print #1, "von " + schichtbeginn + " bis " + schichtende
Else
End If
Else
End If
Next
Next
Next
Next
End If
Next
'----- Beginn 2. Block Textausgabe-----'
Close #1 'Zieldatei schließen
zeigen = Shell(Environ("windir") & "\notepad.exe " & Datei, 1)
Exit Sub
Fehler:
Close #1
MsgBox "FehlerNr.: " & Err.Number & vbNewLine & vbNewLine _
& "Beschreibung: " & Err.Description _
, vbCritical, "Fehler"
'----- Ende 2. Block Textausgabe-----'
End Sub
|