每 30 秒间隔提取数据的 VBA 脚本

Question

我有一个电压输出列表和记录它们的时间戳。对于某些背景，我的测试从 0-5V 每 30 秒将电压增加 1mV。系统每秒读取一次左右，可能不一致。该工作表有超过 70000 行，但我只需要超过 5000 行。

到目前为止，我已经使用 =RIGHT(TEXT(A1, "hh:mm:ss"),2) 从时间中提取秒数。不幸的是，时间戳总是每 30 秒一次，所以我不能简单地过滤每 0 秒和 30 秒。有时会跳过 30 秒，它会显示为 35 秒。

如何创建一个 VBA 脚本，以每 30 秒间隔提取增量，如果没有完美的 30 秒跳跃，请选择最接近的匹配项（即 29 或 31）？

任何指导将不胜感激！

Answer 1

好的，我认为以下将起作用。请注意，这需要作为 Excel 公式数组输入到 Flags 输出列中，函数的输入参数是包含时间的相应列。 （所以输出列的公式应该是：{=FlagEvery30Sec(D2:D36)}）

' Returns 1 if the corresponding row should be used, and 0 otherwise
Public Function FlagEvery30Sec(SourceTimes As Range) As Integer()
    Dim Times() As Variant
    Dim Flags() As Long
    
    ' get the source values
    Times = SourceTimes
    
    ' set the output values array to the same size
    Dim First As Long, Last As Long
    First = LBound(Times, 1)
    Last = UBound(Times, 1)
    ReDim Flags(First To Last, 1 To 1)
    
    Dim curr As Long, prev As Long
    prev = First
    curr = First
    Flags(curr, 1) = 1
    curr = curr + 1
    
    Dim currTime As Date
    Dim currSecs As Double, prevSecs As Double, lastFlagSecs As Double
    lastFlagSecs = CDbl(Times(curr, 1)) * 24 * 60 * 60
    
    While curr <= Last
        Flags(curr, 1) = 0    ' assume not flagged, change later
        currSecs = CDbl(Times(curr, 1)) * 24 * 60 * 60
        If (currSecs - lastFlagSecs) >= 30 Then
            If ((currSecs - lastFlagSecs) - 30) <= (30 - (prevSecs - lastFlagSecs)) Then
                Flags(curr, 1) = 1
                lastFlagSecs = currSecs
            Else
                Flags(prev, 1) = 1
                lastFlagSecs = prevSecs
            End If
        End If
        
        prevSecs = currSecs
        prev = curr
        curr = curr + 1
    Wend
    
    FlagEvery30Sec = Flags
End Function

请注意，基本上有两种方法：

1. 取第一个时间戳，每 30 秒标记一次，然后找到最接近每个标记的条目并标记它。或者，

2. 获取第一个时间戳并找到最接近其后 30 秒的以下条目。然后将该条目的时间作为基本时间戳，并找到最接近其后 30 秒的下一个条目。重复这个直到你到达终点。

我上面的函数使用了第二种方法。您应该注意，这可能会发生偏差，最终结果可能比 TotalSeconds/30 多或少。