Excel 未对齐的时间戳

Question

[已编辑]

我有一个带有两个工作表（表 1 和表 2）的 Excel 工作簿 (.xlsx)。表 1 有 7 列数据（每列大约有 70k 行），而表 2 只有 5 列，大约 250-500 行。每张表的第一列包含数据收集时间的时间戳，格式为 (yyyy-mm-dd_hh:mm:ss)。

差异在于工作表 1 中的数据的数据点间隔为 8 秒。然而，表 2 有零星的数据条目。可能有 4 或 5 个条目以突发形式发生（例如 5 秒间隔），然后在接下来的几个小时内没有另一个条目。

我想做的是重新组织工作表 2，使时间戳与工作表 1 对齐。原因是当我在工作表 1 中绘制数据图表时，可视化看起来很合适，因为数据在整个过程中是均匀分布的。但是，我无法以相同的方式绘制表 2 中的数据，因为数据点以零星的间隔出现。

我对 C# 很熟悉，并考虑尝试创建一个程序，该程序将读取每张工作表的 csv 文件并进行批处理......但即使在那里，我也有点不知道正确的程序会是什么是。有没有办法可以直接在 Excel 中处理？欢迎任何建议。

Answer 1

一点背景。我在三张纸上对此进行了测试。第一张表有 100k 个日期，间隔为 8 秒。第二张表，我有 5 列 300 个数据点，第一列包含零星间隔的日期。我决定不修改第二张纸，因此我的输出在第三张纸中用于测试目的。

我们的逻辑是定位小于目标日期的最大值。这样，我们就在这个定位日期和下一个日期之间的 8 秒内。然后我们从第一张表中获取该值的行，然后将该行用作结果表中的相同行号。然后，我们将第二张表中的值“转移”到结果表中的正确行。

运行时间在我的机器上可以忽略不计。希望这也适合您。 请在您的工作簿副本上进行测试。

Sub Align()
    Dim RefWS As Worksheet, ListWS As Worksheet, ResWS As Worksheet
    Dim RngOne As Range, RngTwo As Range
    Dim RngVal As Variant, Elem As Variant
    Dim LRowOne As Long, LRowTwo As Long, LRowThree As Long
    Dim LocRow As Long, RowCt As Long
    Dim PopRng As Range, StartRow As Long

    With ThisWorkbook
        Set RefWS = .Sheets("Sheet1") 'Modify as necessary.
        Set ListWS = .Sheets("Sheet2") 'Modify as necessary.
        Set ResWS = .Sheets("Sheet3") 'Modify as necessary.
    End With

    LRowOne = RefWS.Range("A" & Rows.Count).End(xlUp).Row
    LRowTwo = ListWS.Range("A" & Rows.Count).End(xlUp).Row

    'Make sure to change based on whether you have headers or not.
    Set RngOne = RefWS.Range("A1:A" & LRowOne) 'Modify as necessary.
    Set RngTwo = ListWS.Range("A1:A" & LRowTwo) 'Modify as necessary.

    RngVal = RngTwo.Value
    'Change RowCt to 2 if you have headers.
    RowCt = 1

    For Each Elem In RngVal
        LocRow = Application.Match(CDbl(Elem), RngOne, 1)
        ResWS.Range("A" & LocRow & ":E" & LocRow).Value = ListWS.Range("A" & RowCt & ":E" & RowCt).Value
        RowCt = RowCt + 1
    Next Elem

    'Autopopulate.
    With ResWS
        LRowThree = .Range("A" & Rows.Count).End(xlUp).Row
        Do
        StartRow = .Range("A" & LRowThree).End(xlUp).Row
        If StartRow > 1 Then StartRow = StartRow + 1
        Set PopRng = .Range("A" & StartRow & ":E" & LRowThree)
        .Range("A" & LRowThree & ":E" & LRowThree).Copy
        PopRng.PasteSpecial xlPasteValues
        LRowThree = StartRow - 1
        Loop Until StartRow = 1
    End With

    Application.CutCopyMode = False
End Sub

同样重要的是要注意，如果两个值匹配，它将获得 最新的 值，而不是最接近的值。首先让我知道运行此操作后您的数据会发生什么。

编辑：根据聊天更新代码。