AW: Soll- Ist Termine vergleichen und Report erstellen
07.05.2010 08:48:31
fcs
Hallo Jessie,
ich hab dir eine entsprechende Prozedur erstellt, hoffe es ist korrekt umgesetzt.
Gruß
Franz
'Code in einem allgemeinen Modul
Option Explicit
Private wksRep As Worksheet, Zeile_R As Long, Spalte_R As Long, ZeileL As Long
Private wksVerz As Worksheet, Zeile_V As Long, Spalte_V As Long
Private bolErledigt As Boolean, iCount As Long
Private datIst As Date, datSoll As Date
Private sLaufNr As String, sPlanlauf As String, sVerantwort As String, sBemerkung As String
Sub ReportErstellen()
Set wksRep = Worksheets("Report")
Set wksVerz = Worksheets("Verzeichnis")
With wksRep
ZeileL = .Cells(.Rows.Count, 1).End(xlUp).Row
If ZeileL > 1 Then
.Range(.Cells(2, 1), .Cells(ZeileL, 7)).ClearContents
End If
End With
Zeile_R = 1 'Zeile mit Spaltentiteln im Report
iCount = 0 'Eintragszähler für Report
With wksVerz
'Zeilen in Spalte 18(R) bearbeiten
For Zeile_V = 6 To .Cells(.Rows.Count, 18).End(xlUp).Row
iCount = iCount + 1
Zeile_R = Zeile_R + 1
bolErledigt = False
wksRep.Cells(Zeile_R, 1) = iCount
wksRep.Cells(Zeile_R, 2) = .Cells(Zeile_V, 18)
'Spalten DU bis DF von rechts nach links abarbeiten
sLaufNr = ""
sPlanlauf = ""
For Spalte_V = 125 To 58 Step -1
'Prüfen auf Datumseintrag
If IsDate(.Cells(Zeile_V, Spalte_V)) Then
'Prüfen, ob Ist-Termin
If InStr(1, .Cells(1, Spalte_V), "(Ist)") > 0 Then
If sLaufNr = "" Then 'Vorgang ist erledigt, der 1. Termin von Rechts ist ein _
Ist-Termin, es gibt keine weiteren Solltermine
sLaufNr = .Cells(3, Spalte_V).Text
datIst = .Cells(Zeile_V, Spalte_V)
sPlanlauf = .Cells(1, Spalte_V)
Call fncVerantwBemerkung(Spalte_V)
wksRep.Cells(Zeile_R, 3) = sLaufNr & " " & sPlanlauf
wksRep.Cells(Zeile_R, 4) = "alle auf Ist"
If sVerantwort "" Then wksRep.Cells(Zeile_R, 6) = sVerantwort
If sBemerkung "" Then wksRep.Cells(Zeile_R, 7) = sBemerkung
Else 'letzter erledigter Vorgang
'vorherigen gemerkten Sollvorgang eintragen
wksRep.Cells(Zeile_R, 3) = sLaufNr & " " & sPlanlauf
wksRep.Cells(Zeile_R, 4) = datSoll
If sVerantwort "" Then wksRep.Cells(Zeile_R, 6) = sVerantwort
If sBemerkung "" Then wksRep.Cells(Zeile_R, 7) = sBemerkung
End If
bolErledigt = True
Exit For
'Prüfen, ob Soll-Termin
ElseIf InStr(1, .Cells(1, Spalte_V), "(Soll)") > 0 Then
'Sollvorgang merken
datSoll = .Cells(Zeile_V, Spalte_V)
sPlanlauf = .Cells(1, Spalte_V)
sLaufNr = .Cells(3, Spalte_V)
Call fncVerantwBemerkung(Spalte_V)
End If
End If
Next
'Formel für Diff. zum Solltermin eintragen
wksRep.Cells(Zeile_R, 5).FormulaR1C1 = "=IF(RC[-1]"""", RC[-1]-TODAY(),""Solltermin fehlt" _
")"
If bolErledigt = False Then 'Plandatensatz noch nicht eingetragen
If sPlanlauf "" Then 'Nur Solltermine sind bisher vorhanden
wksRep.Cells(Zeile_R, 3) = sLaufNr & " " & sPlanlauf
wksRep.Cells(Zeile_R, 4) = datSoll
If sVerantwort "" Then wksRep.Cells(Zeile_R, 6) = sVerantwort
If sBemerkung "" Then wksRep.Cells(Zeile_R, 7) = sBemerkung
Else
'Keine Termineinträge vorhanden
End If
End If
Next
End With
wksRep.Rows.AutoFit
End Sub
Function fncVerantwBemerkung(Spalte)
sBemerkung = ""
sVerantwort = ""
Select Case Spalte 'Spalte mit Ist- oder Soll-Termin
Case 58, 59 '1.01 'Übergabe an PL
sVerantwort = "PL"
Case 62, 63 '1.02 Bauvorlageberechtigter
sVerantwort = wksVerz.Cells(Zeile_V, 61)
sBemerkung = wksVerz.Cells(Zeile_V, 65)
Case 66, 67 '1.03 Übergabe an Planprüfer
sVerantwort = "?"
Case 70, 71 '1.04 Prüfer1
sVerantwort = wksVerz.Cells(Zeile_V, 69)
sBemerkung = wksVerz.Cells(Zeile_V, 73)
Case 75, 76 '1.04 Prüfer2
sVerantwort = wksVerz.Cells(Zeile_V, 74)
sBemerkung = wksVerz.Cells(Zeile_V, 78)
Case 79, 80 '1.04 Revision
sVerantwort = "?" 'wksVerz.Cells(Zeile_V, ?)
sBemerkung = wksVerz.Cells(Zeile_V, 82)
Case 83, 84 '1.05 Prüfung Vertragskonformität
sVerantwort = "BÜW"
Case 87, 88 '1.06 Bauvorlageberechtigter
sVerantwort = wksVerz.Cells(Zeile_V, 86)
sBemerkung = wksVerz.Cells(Zeile_V, 90)
Case 92, 93 '1.07 Prüfstatiker
sVerantwort = wksVerz.Cells(Zeile_V, 91)
sBemerkung = wksVerz.Cells(Zeile_V, 93)
Case 96, 97 '1.08 Übergabe PT1 von Planer an PL und EBA Sb2
sVerantwort = "Planer" 'wksVerz.Cells(Zeile_V, ?)
Case 99, 100 '1.09 Übergabe PT1 von Planer an PL und EBA Sb3
sVerantwort = "Planer" 'wksVerz.Cells(Zeile_V, ?)
Case 102, 103 '1.10 Übergabe PT1 von PL an Planprüfer
sVerantwort = "PL" 'wksVerz.Cells(Zeile_V, ?)
Case 105, 106 '1.11 Übergabe von Planprüfer an PL
sVerantwort = "Planprüfer" 'wksVerz.Cells(Zeile_V, ?)
Case 108, 109 '1.12 Übergabe an Bauherr
sVerantwort = "PL" 'wksVerz.Cells(Zeile_V, ?)
Case 111, 112 '1.13 Übergabe an AN
sVerantwort = "PL" 'wksVerz.Cells(Zeile_V, ?)
Case 114, 115 '1.14 Erstellung PT2 durch AN und Rückgabe PL
sVerantwort = "Auftragnehmer" 'wksVerz.Cells(Zeile_V, ?)
Case 117, 118 '1.15 Übergabe an BKL-CH
sVerantwort = "PL?" 'wksVerz.Cells(Zeile_V, ?)
Case 120, 121 '1.16 Übergabe an Behörde
sVerantwort = "PL?" 'wksVerz.Cells(Zeile_V, ?)
Case 123, 124 '1.17 Übergabe von PL an BÜW
sVerantwort = "PL" 'wksVerz.Cells(Zeile_V, ?)
End Select
End Function