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，因为我希望将开始时间和结束时间都复制到我的“Time Gap”表。我遇到的问题是，第二个间隙时间是如何粘贴偏移的。这是我的公式：

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：请更新主题开始，而不是发布新问题作为答案（帖子下方有编辑链接）

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

4 个答案: