我有以下代码从Excel数据生成PDF报告。需要根据需要多少小时来生成报告 - 小时数不能超过某个特定日期（财政年度结束时）。它需要一定的总小时数，并产生一定数量的报告。报告的上限为每个报告200小时。
因此，例如，如果总共524小时，则需要生成3个报告 - 2个报告200个小时，1个报告124个;除非预计总小时数超过结束日期。此示例中的结束日期为2016年6月30日。
例如，如果我预测一个人每天工作2小时，并且报告的开始日期是2016年11月6日，那么200小时的报告将转换为100天工作，然后结束日期逻辑上是2016年9月19日;除了edict的结束日期必须是2016年6月30日，所以它只是一个19天的报告。
函数WritePDFforms获取此信息并将其放入PDF中，并成功完成。这不是问题所在。
问题是需要524个小时，初始开始日期为11/24/2015。第一份报告应该是200小时或100天，这意味着它将于2016年3月3日结束。第二份报告应为200小时或100天，这意味着它将于2016年11月6日结束。第三份报告应为38小时或19天，这意味着它将于2016年6月30日结束。
目标是在WritePDFforms函数的每次迭代中保存该特定报告的开始日期。因此，例如第一份报告应该有2015年11月24日;第二个应该有3/3/2016;第三个应该有2016年11月6日，它应该停止，因为该报告将在财政年度结束时或6月30日终止。
编写代码的方式是运行布尔检查，并更新extStartDate变量;最终返回false，但extStartDate更新到2016年6月30日，这是保存的最终值。我不希望它最后一次运行;我想在程序进入最后日期之前切断程序，我知道这是最后一次，因为A）报告已达到财政截止或B）没有更多的小时需要报告。
总之 - 函数checkExtensionNeed运行了太多次。在checkExtensionNeed中，最后一次更新变量extStartDate。我不希望它最后一次迭代，如果它最后一次迭代，我不希望更新extStartDate。
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
答案 0 :(得分：0)
你的行为永远不会结束，因为你没有在循环中改变rowNumber
Do While（checkExtensionNeed（RowNumber））= True .... 环
你需要做一个更好的陈述或做出一个＆＃34;退出做＆＃34;当你满足了你的要求时。
你也错过了函数和子函数中的一些错误处理。