函数未终止

Question

我有以下代码可以从 excel 数据生成 PDF 报告。需要根据需要多少小时来生成报告 - 小时数不能超过某个日期（财政年度结束）。它需要一定数量的总小时数，并产生一定数量的报告。报告的上限为每份报告 200 小时。

例如，如果总小时数为 524，则需要生成 3 个报告 - 2 个 200 小时的报告，1 个 124 小时的报告；除非预计总小时数会超过结束日期。此示例中的结束日期是 2016 年 6 月 30 日。

例如，如果我预计一个人每天工作 2 小时，并且报告的开始日期是 2016 年 6 月 11 日，那么 200 小时的报告将转换为 100 天的工作，那么结束日期将逻辑上是 2016 年 9 月 19 日；除了法令的结束日期必须是 2016 年 6 月 30 日，因此它只会是 19 天的报告。

函数 WritePDFforms 获取此信息并将其放入 PDF 中，并且成功完成。这不是问题所在。

问题是总共需要 524 小时，初始开始日期为 2015 年 11 月 24 日。第一份报告应为 200 小时或 100 天，这意味着它将在 2016 年 3 月 3 日结束。第二份报告应为 200 小时或 100 天，这意味着它将在 2016 年 6 月 11 日结束。第三次报告应为 38 小时或 19 天，这意味着它将在 2016 年 6 月 30 日结束。

目标是在 WritePDFforms 函数的每次迭代中保存该特定报告的开始日期。例如，第一份报告应该是 2015 年 11 月 24 日；第二个应该是 2016 年 3 月 3 日；第三个应该是 2016 年 6 月 11 日，然后应该停止，因为该报告将在财政年度结束时或 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

Answer 1

你的 do while 永远不会结束，因为你没有在循环期间更改 rowNumber

Do While (checkExtensionNeed(RowNumber)) = True …… 循环

当您满足您的要求时，您需要做出更好的声明或“退出”。

而且你的函数和子函数中也缺少一些错误处理。