在VBA中比较时间

朋友们，

我试图扫描一列时间，如果时间戳在过去两分钟+7小时内，则复制/粘贴该行。 我的时间戳的date部分没有阵容，我需要将它们转换为相同的date，而不会改变时间。

这是我的代码：

Sub Timecompare() Dim i As Integer Dim lRow As Integer Dim ws1 As Worksheet Dim ws2 As Worksheet Set ws1 = Sheets("Volm") Set ws2 = Sheets("Sheet2") 'goal: 'scan all rows in dataset 'if cell time > current time - 2 minutes 'copy pasta With ws1 'find the last row lRow = .Cells(.Rows.Count, "E").End(xlUp).Row 'loop through all the rows For i = 10 To lRow 'if the cell value is greater than time + 7 hours - 2 minutes then copy/paste the row to new sheet If .Cells(i, 18).Value > Now + TimeSerial(7, 0, 0) - TimeSerial(0, 2, 0) Then ''' just spitting out the values in the comparator above so I can see the results and why they aren't comparing properly ''' ws2.Cells(i, 1).Value = .Cells(i, 18).Value ws2.Cells(i, 2).Value = Now + TimeSerial(7, 0, 0) - TimeSerial(0, 2, 0) Exit For End If Next i End With End Sub 

“.Cells（i，18）.Value”输出如下所示：.704461794（一般格式）或1/0/00 4:54 PM（date格式）

“Now + TimeSerial（7，0，0） – TimeSerial（0,2,0）”输出如下所示：42467.75336（通用格式）或4/7/16 6:04 PM（date格式）。

我不在乎date。 我所关心的是时间。 那么有没有办法把“.Cells（i，18）.Value”带到今天，或者把Now（）+ 7小时-2分钟的date返回到1/0/00？ 重申一下，我只是想把我的苹果拿到苹果上来，这样我就可以比较一下时间。

Answer 1

我会简单地提取时间：

 upperTime = GetTime(Now + TimeSerial(7, 0, 0) - TimeSerial(0, 2, 0)) With ws1 For i = 10 To lRow ' compare on the time only ' If GetTime(.Cells(i, 18).Value) > upperTime Then ' copy the time only ' ws2.Cells(i, 1).Value = GetTime(.Cells(i, 18).Value) ' copy the current date plus the time from the cell ' ws2.Cells(i, 2).Value = GetDate(Now) + GetTime(.Cells(i, 18).Value) Exit For End If Next i End With 

提取date部分或时间部分的函数：

 ' Returns the date part from a date/time ' Public Function GetTime(datetime As Date) As Date GetTime = datetime - VBA.Fix(datetime) End Function ' Returns the time part from a date/time ' Public Function GetDate(datetime As Date) As Date GetDate = VBA.Fix(datetime) End Function 

Answer 2

创build一个variables，并将Now + TimeSerial(7, 0, 0) - TimeSerial(0, 2, 0)赋值给循环外部。 在循环中使用该variables而不是expression式（我可以看到2个地方）

创build另一个variables，并在循环之外将today（）赋值给它。 在比较中使用.Cells(i, 18).Value + <That Variable> 。 如果你不认为这个macros的执行会跨越午夜，你可以直接使用today（）而不是使用variables。

Answer 3

我相信你的algorithm必须考虑到午夜十字路口。 基于你的问题的措辞（在你的代码示例上面），我尝试了下面的testing：

 Option Explicit Sub test() Dim pastLimit As Date Dim futureLimit As Date Dim timestamps() As Variant Dim testtime As Variant timestamps = Array(DateValue("4/7/2016") + TimeValue("12:43:00 PM"), _ DateValue("4/7/2016") + TimeValue(" 1:43:00 PM"), _ DateValue("4/7/2016") + TimeValue(" 2:43:00 PM"), _ DateValue("4/7/2016") + TimeValue(" 3:43:00 PM"), _ DateValue("4/7/2016") + TimeValue(" 4:43:00 PM"), _ DateValue("4/7/2016") + TimeValue(" 5:43:00 PM")) pastLimit = Now + TimeSerial(0, 2, 0) futureLimit = Now + TimeSerial(7, 0, 0) - TimeSerial(0, 2, 0) For Each testtime In timestamps If (testtime > pastLimit) And (testtime < futureLimit) Then Debug.Print "in the window: " & Format(testtime, "hh:mm:ss ampm") End If Next testtime End Sub 

这貌似给你想要的结果。