循环寻找时间间隔并复制到另一个工作表

Question

我有这样的时间列表：

Start time  End Time        Difference between times
10:31:53    10:34:40        0.000115741
10:34:50    10:35:21        0.000196759
10:35:38    10:37:17        0.000138889
10:37:29    10:37:52        0.000358796
10:38:23    10:40:01        0.000324074
10:40:29    10:40:59        4.62963E-05
10:41:03    10:41:46        0.000173611
10:42:01    10:42:33        0.000104167

我正在尝试设置VBA，以查找大于40分钟（0.02777778）的差异，一旦找到它，它就会复制开始和结束时间。可能有多个间隔时间大于 40 分钟，所以我想将它们全部复制（最好像列表一样垂直向右）。

这是我到目前为止所拥有的：

Dim i As Range
For Each i In Range("F14:F30000").SpecialCells(xlCellTypeVisible)
    If i.Value > 0.02777778 Then
        i.Select
        Selection.Offset(, -2).Copy Destination:=Sheets("Time Gaps").Range("B3")
        i.Select
        Selection.Offset(1, -3).Copy Destination:=Sheets("Time Gaps").Range("D3")
    End If
Next i

但它只复制符合标准的最后一个间隔时间。我怎样才能让它记录所有这些？

提前感谢！

Answer 1

问题在于您总是粘贴到 B3/D3。要解决此问题，您还需要创建目标变量。一种方法是创建一个指向目标单元格的范围变量，并在每次找到匹配项时移动引用，从;

Dim rDest as range
Set rDest = Sheets("Time Gaps").Range("D3") 'init reference

然后将复制行替换为;

Selection.Offset(, -2).Copy Destination:=rDest

您可以使用 rDest.offset 对目标单元格进行相对偏移。

在结束之前，如果添加以下行;

Set rDest = rDest.Offset(1,0) 'set range to next row

Answer 2

您始终将结果复制到单元格 B3/D3，以便覆盖除最后一个结果之外的所有结果。

最简单的方法可能是确定数据覆盖在哪一行中的计数器：

Dim i As Range
dim counter as Integer
For Each i In Range("F14:F30000").SpecialCells(xlCellTypeVisible)
    If i.Value > 0.02777778 Then
        i.Select
        Selection.Offset(, -2).Copy Destination:=Sheets("Time Gaps").Cells(counter + 3, 2)
        i.Select
        Selection.Offset(1, -3).Copy Destination:=Sheets("Time Gaps").Cells(counter + 3, 2)
        counter = counter + 1
    End If
Next i

Answer 3

这工作得很好。我添加了 rDest2，因为我希望将开始时间和结束时间都复制到我的"时间间隔"工作表中。不过，我对找到的第二个间隔时间如何粘贴偏移量有问题。这是我的公式：

Dim i As Range
Dim rDest As Range
Dim rDest2 As Range
Set rDest = Sheets("Time Gaps").Range("B3")
Set rDest2 = Sheets("Time Gaps").Range("D3")
For Each i In Range("F14:F30000").SpecialCells(xlCellTypeVisible)
    If i.Value > 0.02777778 Then
        i.Select
        Selection.Offset(, -2).Copy Destination:=rDest
        i.Select
        Selection.Offset(1, -3).Copy Destination:=rDest2
        Set rDest = rDest.Offset(0, 4)
        Set rDest2 = rDest.Offset(0, 4)
    End If
Next i

我尝试发布到的时间间隙表的标题如下所示：

(Time Start) (Time Gap) (Time End) (Time Start) (Time Gap) (Time End)(Time Start) (Time Gap) (Time End)

Answer 4

看起来您偏移了 4 列，而您的标题以 3 为一组重复。您可能需要偏移量（0,3）。另请查看DLem的评论。

PS：你不需要声明另一个变量 rDest2，试试;

    i.Offset(, -2).Copy Destination:=rDest
    i.Offset(1, -3).Copy Destination:=rDest.offset(0,1) 'or (0,2) if the 2nd item has to be 2 columns to the right

PS2：请更新主题开始，而不是发布新问题作为答案（帖子下方有一个编辑链接）