Question

我还没有找到任何关于此的信息，如果您之前曾被询问过，请对不起。 已编辑

我在列中列出了许多日期和时间，并且它们之间的小时数有所不同。从底部（最早的日期）开始，我正在寻找距离超过24小时的下一行，并在“下次超过24小时”下显示该值。提供样品。

+------------+-------+--+-----------------------+-------+
| Date       | Time  |  | Next Time over 24 Hrs |       |
+------------+-------+--+-----------------------+-------+
| 04/15/2018 | 16:09 |  | None                  | None  |
+------------+-------+--+-----------------------+-------+
| 04/15/2018 | 12:11 |  | None                  | None  |
+------------+-------+--+-----------------------+-------+
| 04/15/2018 | 06:10 |  | None                  | None  |
+------------+-------+--+-----------------------+-------+
| 04/14/2018 | 14:24 |  | 04/15/2018            | 16:09 |
+------------+-------+--+-----------------------+-------+
| 04/14/2018 | 06:10 |  | 04/15/2018            | 06:10 |
+------------+-------+--+-----------------------+-------+
| 04/13/2018 | 07:31 |  | 04/14/2018            | 14:24 |
+------------+-------+--+-----------------------+-------+
| 04/13/2018 | 07:31 |  | 04/14/2018            | 14:24 |
+------------+-------+--+-----------------------+-------+
| 04/13/2018 | 06:39 |  | 04/14/2018            | 14:24 |
+------------+-------+--+-----------------------+-------+
| 04/13/2018 | 06:10 |  | 04/14/2018            | 06:10 |
+------------+-------+--+-----------------------+-------+

*更新：此处使用的最终代码

Sub test()

Dim x As Long
Dim i As Long
Dim xTime As Double
Dim iTime As Double
Dim LastRow As Long

LastRow = Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row

         For x = LastRow + 1 To 2 Step -1
          If Cells(x, "F") = "VALUE" Then
            xTime = Cells(x, "A").Value + Cells(x, "B").Value
            For i = x To 2 Step -1
                iTime = Cells(i, "A").Value + Cells(i, "B").Value
                If iTime - xTime = 1 Or iTime - xTime > 1 Then
                    Cells(x, "R").Value = Cells(i, "A").Value
                    Cells(x, "S").Value = Cells(i, "B").Value
                    Exit For
                End If
            Next I
          End If
        Next x


End Sub

Answer 1

对于仅使用公式的方法并使用额外的列：

您的Date and Time表从A1:B10开始。

将此公式添加到C2并向下拖动到C10：
=SUM($A2,$B2)
将此公式添加到D2并向下拖动到D10：
=IFERROR(INDEX($A$2:$A2,MATCH($C2+1,$C$2:$C2,-1)),"")
将此添加到E2并向下拖动：
=IFERROR(INDEX($B$2:$B2,MATCH($C2+1,$C$2:$C2,-1)),"")

如果日期列包含日期和时间，但其格式设置为仅显示日期，则可以将对C列的引用更改为A列。

| Date       | Time  | Hidden           | Next Time over 24 Hrs                                 |                                                       |
|------------|-------|------------------|-------------------------------------------------------|-------------------------------------------------------|
| 15/04/2018 | 16:09 | =SUM($A2,$B2)    | =IFERROR(INDEX($A$2:$A2,MATCH($C2+1,$C$2:$C2,-1)),"") | =IFERROR(INDEX($B$2:$B2,MATCH($C2+1,$C$2:$C2,-1)),"") |
| 15/04/2018 | 12:11 | 15/04/2018 12:11 |                                                       |                                                       |
| 15/04/2018 | 06:10 | 15/04/2018 06:10 |                                                       |                                                       |
| 14/04/2018 | 14:24 | 14/04/2018 14:24 |                                                       |                                                       |
| 14/04/2018 | 06:10 | 14/04/2018 06:10 | 15/04/2018                                            | 06:10                                                 |
| 13/04/2018 | 07:31 | 13/04/2018 07:31 | 14/04/2018                                            | 14:24                                                 |
| 13/04/2018 | 07:31 | 13/04/2018 07:31 | 14/04/2018                                            | 14:24                                                 |
| 13/04/2018 | 06:39 | 13/04/2018 06:39 | 14/04/2018                                            | 14:24                                                 |
| 13/04/2018 | 06:10 | 13/04/2018 06:10 | 14/04/2018                                            | 06:10                                                 |

Answer 2

尝试一下。如果我正确理解了您的请求，就可以解决问题。

Option Explicit
Sub time()

Dim x As Long
Dim i As Long
Dim xTime As Double
Dim iTime As Double
Dim LastRow As Long

'adjust worksheet and table names accordingly to mach yours
LastRow = Worksheets("Sheet1").Range("Table1").Rows.Count

    For x = LastRow + 1 To 2 Step -1
        xTime = Cells(x, "A").Value + Cells(x, "B").Value
        For i = x To 2 Step -1
            iTime = Cells(i, "A").Value + Cells(i, "B").Value
            If iTime - xTime = 1 Or iTime - xTime > 1 Then
                Cells(x, "C").Value = Cells(i, "A").Value
                Cells(x, "D").Value = Cells(i, "B").Value
                Exit For
            End If
            Next i
        Next x

End Sub

VBA：添加行值，直到它们大于或等于X

2 个答案: