如何在Excel中将断点时间序列转换为1秒分辨率时间序列

Question

我有一个断点时间序列（当监控值更改时，会创建一个新的时间戳），它是使用 1 秒的精度创建的（时间戳格式为 yyyy:mm:dd:ss），我想更改该时间系列到 1 秒分辨率的时间序列。

基本上，这意味着在断点时间戳之间添加额外的行和时间戳，并且这些新时间戳需要保存受监控实体的最后一个值。

示例 断点时间序列

想要 1 秒分辨率时间序列

等等。我希望你能明白。

问题是我不知道如何开始处理这个问题，我还没能从档案中找到那么多类似的案例。

解决此类困境的好方法是什么，以及如何将所描述的解决方案实现为 VBA 代码？

如有任何帮助，我们将不胜感激。

谢谢 BR 穆杰

编辑： 我创建了一个简短的脚本，可以添加缺失的行并将上面的值复制到这个新行。然而，我仍然在处理断点时间序列中缺失超过 1 秒的情况。代码如下：

Option Explicit
Sub BP_to_sec()

Dim wb As Workbook
Set wb = ThisWorkbook
Dim ws As Worksheet
Set ws = wb.Sheets("Test")

Dim LastRow As Long
Dim RowStep As Long

Dim S As Double
S = (1 / 86400)

LastRow = Range("A" & Rows.Count).End(xlUp).Row
 For RowStep = LastRow To 3 Step -1
   If Not IsEmpty(Range("A" & RowStep)) Then
     If (CDate(Range("A" & RowStep)) > (CDate(Range("A" & RowStep - 1)) + S)) Then
       Range("A" & RowStep).EntireRow.Insert
        Cells(RowStep, 1).Value = Cells(RowStep - 1, 1).Value + S
        Cells(RowStep, 2).Value = Cells(RowStep - 1, 2).Value
     End If
   End If
 Next

MsgBox ("Sorted")

End Sub

Answer 1

我自己也想出了一个解决方案！如果有人发现完全相同的问题，我会将其发布在这里。

Option Explicit
Sub BP_to_sec1()

Dim wb As Workbook
Set wb = ThisWorkbook
Dim ws As Worksheet
Set ws = wb.Sheets("Test")

Dim LastRow As Integer
Dim RowStep As Integer
Dim FillRow As Integer

Dim S As Double
Dim SS As Double
S = (1 / 86400)     ' 1 sec
SS = (1.2 / 86400)  ' 1.2 sec dif

Dim X As Integer

LastRow = Range("A" & Rows.Count).End(xlUp).Row
 For RowStep = LastRow To 3 Step -1
   If Not IsEmpty(Range("A" & RowStep)) Then
     If (CDate(Range("A" & RowStep)) > (CDate(Range("A" & RowStep - 1)) + SS)) Then
        X = ((Second((Range("A" & RowStep))) - (Second(Range("A" & RowStep - 1)))))
        Range("A" & RowStep).EntireRow.Offset(0).Resize(X - 1).Insert Shift:=xlDown
         If X > 0 Then
            For FillRow = RowStep To (RowStep + (X - 2)) Step 1
                Range("A" & FillRow).Value = Range("A" & (FillRow - 1)).Value + S
                Range("B" & FillRow, "AA" & FillRow).Value = Range("B" & (FillRow - 1), "AA" & (FillRow - 1)).Value
            Next
         End If
     End If
   End If
 Next

MsgBox ("Sorted")

End Sub

作为评论，在这个解决方案中，我使用的数据范围更广，一直到达“AA”列，因此我进行了编辑以复制下面的所有数据，当然时间戳除外，它添加了 1 秒。

也非常感谢@h2so4的回答，我还没有测试过，但似乎我们正在使用相同的元素。我的版本也有点乱...

欢迎任何意见！

感谢您的帮助！ BR 穆杰

Answer 2

试试这个

Option Explicit
Sub BP_to_sec()
        
        Dim wb As Workbook
        Set wb = ThisWorkbook
        Dim ws As Worksheet
        Set ws = wb.Sheets("Test")
        
        Dim LastRow As Long
        Dim RowStep As Long
        
        Dim S As Double
        S = (1 / 86400)
        
        LastRow = Range("A" & Rows.Count).End(xlUp).Row
        RowStep = LastRow
        Do While RowStep > 3
            If Not IsEmpty(Range("A" & RowStep)) Then
                If (CDate(Range("A" & RowStep)) - (CDate(Range("A" & RowStep - 1)) + S)) > S Then
                    Range("A" & RowStep).EntireRow.Insert
                    Cells(RowStep, 1).Value = Cells(RowStep + 1, 1).Value - S
                    Cells(RowStep, 2).Value = Cells(RowStep - 1, 2).Value
                    RowStep = RowStep + 1
                End If
            End If
            RowStep = RowStep - 1
        Loop
        
        MsgBox ("Sorted")
    
End Sub