期望的結果是計算一個范圍內大于 24 小時的日期值的數量。代碼有效；但是，它并不能按預期作業。在這個特定的應用程式中，有三個日期早于 24 小時。請參閱用“此處”一詞注釋的相關代碼行。
我的問題是我將變數作為日期傳遞，但這是否僅包括與其他日期資料型別比較并排除時間（或小數值）時的日期，還是日期也包括小時？我的直覺告訴我，這只是計算日期（整個序列號部分），而不是代表時間的序列號的小數部分，這就是為什么一個值不符合標準，即使它確實早于 24小時。
澄清一下，根據既定標準，總共應回傳三個值：我希望變數cellCounter評估為 3，但僅回傳值 2，即使確實有 3 個日期早于從當前時間/日期算起的 24 小時。
在 Locals Windows 中，我注意到變數todaysDate的計算結果為 #12:00:00 AM# 而不是日期（此變數在程序中沒有實際用途）。就讓程式識別超過 24 小時的日期而言，我錯過了什么？
Function ExpiredEscortsListBoxArray() As Variant
'Dimension and assign variables
Dim arrTempList2() As Variant
Dim rowCount As Single, listCounter As Single, cellCounter As Single
Dim i As Single, ri As Single, ci As Single, c As Single
Dim oRow As ListRow, rowi As Single
Dim rowiBlank As Single
Dim it As Variant
Dim currDate As Date 'Here
Dim todaysDate As Date 'Here
Dim wbkVMS As Workbook: Set wbkVMS = ThisWorkbook
Dim wks As Worksheet
Dim lo As ListObject
Set wks = wbkVMS.Worksheets("Visitor Log")
Set lo = wks.ListObjects("tblVisitorLog")
'Initialize variables
cellCounter = 0
i = 0
ri = 0
ci = 0
c = 0
currDate = Date 'Here
currDate = currDate - 1 'Here
'Assign blank cell count to variable. This variable will determine size of dynamic array.
For Each oRow In lo.ListRows
rowi = rowi 1
If lo.Range.Cells(rowi 1, 15).Value < currDate And lo.Range.Cells(rowi 1, 16) = "" Then 'Here
cellCounter = cellCounter 1
End If
Next
If cellCounter = 0 Then
ReDim arrTempList2(0, 16)
arrTempList2(0, 0) = " "
arrTempList2(0, 1) = "No Expired Escorts"
arrTempList2(0, 2) = " "
arrTempList2(0, 3) = " "
arrTempList2(0, 4) = " "
arrTempList2(0, 5) = " "
arrTempList2(0, 6) = " "
arrTempList2(0, 7) = " "
arrTempList2(0, 8) = " "
arrTempList2(0, 9) = " "
arrTempList2(0, 10) = " "
arrTempList2(0, 11) = " "
arrTempList2(0, 12) = " "
arrTempList2(0, 13) = " "
arrTempList2(0, 14) = " "
arrTempList2(0, 15) = " "
arrTempList2(0, 16) = " "
ExpiredEscortsListBoxArray = arrTempList2
GoTo CancelFunction
End If
ReDim arrTempList2(cellCounter - 1, 16)
For listCounter = 1 To lo.ListRows.Count 'Increments based on the total rows on "Visitor Log"
'Selects the row if the "End" field (14th column) is blank
If lo.Range.Cells(listCounter 1, 16) = "" Then
If lo.Range.Cells(listCounter 1, 15).Value < currDate Then 'Here
ri = ri 1
For ci = 0 To 16 'Starts inner loop index for the listbox control column
c = c 1 'Increments the list range column of the "Visitor Log"
arrTempList2(ri - 1, ci) = lo.Range.Cells(listCounter 1, c).Value
Next ci
End If
End If
c = 0
Next listCounter
ExpiredEscortsListBoxArray = arrTempList2
CancelFunction:
End Function
uj5u.com熱心網友回復：
使用DateDiff內置功能會有所幫助。此外，創建一個進行時間比較的函式將使測驗和“撥入”您正在尋找的時間測量變得更加容易。下面的代碼是原始代碼，添加了一個IsMoreThan24Hours函式來隔離比較功能。
Public Function ExpiredEscortsListBoxArray() As Variant
'Dimension and assign variables
Dim arrTempList2() As Variant
Dim rowCount As Single, listCounter As Single, cellCounter As Single
Dim i As Single, ri As Single, ci As Single, c As Single
Dim oRow As ListRow, rowi As Single
Dim rowiBlank As Single
Dim it As Variant
Dim currDate As Date 'Here
Dim todaysDate As Date 'Here
Dim wbkVMS As Workbook: Set wbkVMS = ThisWorkbook
Dim wks As Worksheet
Dim lo As ListObject
Set wks = wbkVMS.Worksheets("Visitor Log")
Set lo = wks.ListObjects("tblVisitorLog")
'Initialize variables
cellCounter = 0
i = 0
ri = 0
ci = 0
c = 0
currDate = Date 'Here
currDate = currDate - 1 'Here
Dim currentDateTime As Date
currentDateTime = Now
'Assign blank cell count to variable. This variable will determine size of dynamic array.
For Each oRow In lo.ListRows
rowi = rowi 1
'******************************
'If lo.Range.Cells(rowi 1, 15).Value < currDate And lo.Range.Cells(rowi 1, 16) = "" Then 'Here
If IsMoreThan24Hours(currentDateTime, lo.Range.Cells(rowi 1, 15).Value) And lo.Range.Cells(rowi 1, 16) = "" Then 'Here
cellCounter = cellCounter 1
End If
'*******************************
Next
If cellCounter = 0 Then
ReDim arrTempList2(0, 16)
arrTempList2(0, 0) = " "
arrTempList2(0, 1) = "No Expired Escorts"
arrTempList2(0, 2) = " "
arrTempList2(0, 3) = " "
arrTempList2(0, 4) = " "
arrTempList2(0, 5) = " "
arrTempList2(0, 6) = " "
arrTempList2(0, 7) = " "
arrTempList2(0, 8) = " "
arrTempList2(0, 9) = " "
arrTempList2(0, 10) = " "
arrTempList2(0, 11) = " "
arrTempList2(0, 12) = " "
arrTempList2(0, 13) = " "
arrTempList2(0, 14) = " "
arrTempList2(0, 15) = " "
arrTempList2(0, 16) = " "
ExpiredEscortsListBoxArray = arrTempList2
GoTo CancelFunction
End If
ReDim arrTempList2(cellCounter - 1, 16)
For listCounter = 1 To lo.ListRows.Count 'Increments based on the total rows on "Visitor Log"
'Selects the row if the "End" field (14th column) is blank
If lo.Range.Cells(listCounter 1, 16) = "" Then
'******************************
'If lo.Range.Cells(listCounter 1, 15).Value < currDate Then 'Here
If IsMoreThan24Hours(currentDateTime, lo.Range.Cells(listCounter 1, 15).Value) Then 'Here
ri = ri 1
For ci = 0 To 16 'Starts inner loop index for the listbox control column
c = c 1 'Increments the list range column of the "Visitor Log"
arrTempList2(ri - 1, ci) = lo.Range.Cells(listCounter 1, c).Value
Next ci
End If
'******************************
End If
c = 0
Next listCounter
ExpiredEscortsListBoxArray = arrTempList2
CancelFunction:
End Function
Private Function IsMoreThan24Hours(ByVal currentDateTime As Date, ByVal dateTimeToCheck As Variant) As Boolean
Dim diffHours As Variant
diffHours = DateDiff("h", currentDateTime, dateTimeToCheck)
IsMoreThan24Hours = diffHours <= -24
End Function
轉載請註明出處，本文鏈接：https://www.uj5u.com/shujuku/434848.html