Ich habe den folgenden Code, der PDF-Berichte aus Excel-Daten erzeugt. Berichte müssen erstellt werden auf der Grundlage, wie viele Stunden benötigt werden - die Anzahl der Stunden kann nicht über ein bestimmtes Datum (das Ende des Geschäftsjahres) hinausgehen. Es benötigt eine bestimmte Menge an benötigten Stunden und erzeugt eine bestimmte Anzahl von Berichten. Die Berichte sind auf 200 Stunden pro Bericht begrenzt.Funktion nicht beendet
Zum Beispiel, wenn es insgesamt 524 Stunden gibt, dann müssen 3 Berichte erzeugt werden - 2 Berichte von 200 Stunden, 1 Bericht von 124; es sei denn, die Gesamtstunden werden voraussichtlich über das Enddatum hinausgehen. Das Enddatum in diesem Beispiel ist der 30.06.2016.
Wenn ich zum Beispiel vorschlage, dass eine Person 2 Stunden am Tag arbeitet und das Datum des Berichts am 6.1.2016 ist, würde ein 200-Stunden-Bericht in 100 Arbeitstage und das Enddatum übersetzt werden dann logisch 19.9.2016; außer das Enddatum per Erlass muss der 30.06.2016 sein, also wäre es nur ein 19-Tage-Bericht.
Die Funktion WritePDFforms nimmt diese Informationen und fügt sie in ein PDF ein, und zwar erfolgreich. Das ist nicht das Problem.
Das Problem ist, dass 524 Stunden insgesamt benötigt werden, und ein Startdatum am 24.11.2015. Der erste Bericht sollte 200 Stunden oder 100 Tage umfassen, was bedeutet, dass er am 03.03.2016 endet. Der zweite Bericht sollte 200 Stunden oder 100 Tage umfassen, was bedeutet, dass er am 06.11.2016 endet. Der dritte Bericht sollte 38 Stunden oder 19 Tage umfassen, was bedeutet, dass er am 30. Juni 2016 endet.
Das Ziel ist, in jeder Iteration speichern von der WritePDFforms das Startdatum dieses spezifischen Berichts funktionieren. So sollte zum Beispiel der erste Bericht den 24.11.2015 haben; der zweite sollte 3/3/2016 haben; der dritte sollte den 11.6.2016 haben, und er sollte dann aufhören, weil dieser Bericht am Ende des Geschäftsjahres oder am 30.6. endet.
Die Art und Weise der Code geschrieben wird, ist, dass es die boolean Prüfung ausgeführt wird, und aktualisiert die extStartDate Variable; gibt ultimativ false zurück, aber extStartDate wird auf den 30.6.2016 aktualisiert, und das ist der endgültige Wert, der gespeichert wird. Ich möchte nicht, dass es das letzte Mal läuft. Ich möchte das Programm abzuschneiden, bevor es an dem letzten Tag geht, und ich weiß, dass es das letzte Mal ist, weil entweder A) Die Berichte der steuerlichen Cutoff oder B erreicht haben) gibt es nicht mehr Stunden, die gemeldet werden müssen.
In Summe - die Funktion checkExtensionNeed läuft einmal zu oft. In checkExtensionNeed wurde die Variable extStartDate zuletzt aktualisiert. Ich möchte nicht, dass es das letzte Mal iteriert, und wenn es das letzte Mal iteriert, möchte ich nicht, dass extStartDate aktualisiert wird.
Option Explicit
Dim totalHoursNeeded As Long
Dim extStartDate As Date
Dim lastBillableDate As Date
Dim daysRemaining As Long
Dim hoursPerDay As Long
Dim hoursColumn As Long
Dim dateLastApproved As Date
Dim dateLastWritten As Date
Dim startDate As Date
Dim amountLastApproved As Long
Dim amountLastWritten As Long
Dim extensionSheet As Worksheet
Dim totalHoursInExt As Long
'preliminary subroutine, calls writepdfforms
'called from the double click method
'shName = worksheet that gets the double click
'RowNumber = row of the double clicked cell
Public Sub FillSelectedForms(ShName As Worksheet, RowNumber As Long)
Dim cell As Range, wks As Worksheet, Templ As ListObject, ExitLine As Label
Dim i As Long
Set extensionSheet = ThisWorkbook.Worksheets("Extensions")
'get template list
Set wks = ThisWorkbook.Worksheets("Templates List")
Set Templ = wks.ListObjects(1)
If Templ.ListColumns(1).DataBodyRange Is Nothing Then
MsgBox "No data found in Templates List", vbInformation, "Missing Data"
GoTo ExitLine
End If
'databodyrange = first column in the data (not header) cell 1
Set cell = Templ.ListColumns(1).DataBodyRange.Cells(1)
For i = 1 To extensionSheet.Range("G1").End(xlToRight).column
If InStr(1, extensionSheet.Cells(1, i).Text, "Average number of hours") > 0 Then
hoursPerDay = extensionSheet.Cells(RowNumber, i)/7
ElseIf InStr(1, extensionSheet.Cells(1, i).Text, "73 - Total Requested Hours") > 0 Then
hoursColumn = i
Else
End If
Next i
'first find total amount of hours needed
totalHoursNeeded = Worksheets("Summary").Cells(RowNumber, 12)
'do while
Do While (checkExtensionNeed(RowNumber)) = True
' MsgBox ("On iteration " & i & " Total Hours in Extension is " & totalHoursInExt & " Last Date Written is " & dateLastWritten)
' i = i + 1
If totalHoursNeeded >= 200 Then
'would a 200 hour extension go past the lastBillableDate?
If DateAdd("d", totalHoursInExt/hoursPerDay, extStartDate) > lastBillableDate Then
'go up to the last billable date and not further
totalHoursInExt = CLng(daysRemaining/hoursPerDay)
Else
totalHoursInExt = 200
End If
extensionSheet.Cells(RowNumber, hoursColumn) = totalHoursInExt
Else
'if there is less than 200 hours remaining AND would a full extension go past the last billable date
If DateAdd("d", totalHoursInExt/hoursPerDay, extStartDate) > lastBillableDate Then
totalHoursInExt = CLng(daysRemaining * hoursPerDay)
Else
totalHoursInExt = totalHoursNeeded
End If
extensionSheet.Cells(RowNumber, hoursColumn) = totalHoursInExt
End If
WritePDFForms ShName.Name, RowNumber, cell, cell.Offset(0, 1)
extensionSheet.Cells(RowNumber, hoursColumn + 1) = DateAdd("d", totalHoursInExt/hoursPerDay, extStartDate)
totalHoursNeeded = totalHoursNeeded - totalHoursInExt
Loop
MsgBox (extensionSheet.Cells(RowNumber, hoursColumn + 1))
ExitLine:
Set Templ = Nothing
Set wks = Nothing
Set cell = Nothing
End Sub
Public Function checkExtensionNeed(Row As Long)
' Find start date of Extension
' Find year/wage pair
' Find total number of hours needed in extension
Dim summarySheet As Worksheet, extensionSheet As Worksheet, i As Long
Dim j As Long
Set summarySheet = ThisWorkbook.Worksheets("Summary")
Set extensionSheet = ThisWorkbook.Worksheets("Extensions")
'find dates for comparison
For i = 1 To extensionSheet.Range("A1").End(xlToRight).column
'find date of last approved extension
If InStr(1, summarySheet.Cells(1, i), "Year 1 Most Recent Extension Approval Date") > 0 Then
dateLastApproved = summarySheet.Cells(Row, i)
'find date of last written extension
ElseIf InStr(1, extensionSheet.Cells(1, i), "Start Date (To be Calculcated)") > 0 Then
dateLastWritten = extensionSheet.Cells(Row, i)
'find date of start in Project Sweep
ElseIf InStr(1, summarySheet.Cells(1, i), "Year 1 Start Date") > 0 Then
startDate = summarySheet.Cells(Row, i)
ElseIf InStr(1, summarySheet.Cells(1, i), "Year 1 Most Recent Extension Approval Amount") > 0 Then
amountLastApproved = summarySheet.Cells(Row, i)
ElseIf InStr(1, extensionSheet.Cells(1, i), "Total Requested Hours") > 0 Then
amountLastWritten = extensionSheet.Cells(Row, i)
End If
Next i
If dateLastApproved > dateLastWritten Then
extStartDate = DateAdd("d", amountLastApproved/hoursPerDay, dateLastApproved)
extensionSheet.Cells(Row, hoursColumn + 1) = extStartDate
Else
extStartDate = dateLastWritten
'extensionSheet.Cells(Row, hoursColumn + 1) = dateLastWritten
End If
lastBillableDate = DateAdd("d", 365, startDate)
daysRemaining = lastBillableDate - extStartDate
If extStartDate < lastBillableDate And totalHoursNeeded > 0 Then
checkExtensionNeed = True
Else
checkExtensionNeed = False
End If
End Function