查找并插入缺少时间戳的行，删除不需要的时间戳的行

Question

我有一个巨大的表格，其中包含大约 24000 行 800 小时的数据，其中每个单元格的间隔为 2 分钟。表中的样本值为：

station,  date,             used, free
1,        5/21/2008 12:00   6     15
1,        5/21/2008 12:02,  7,    14
1,        5/21/2008 12:04,  6,    15
1,        5/21/2008 12:08,  5,    16
1,        5/21/2008 12:14,  6,    15
1,        5/21/2008 12:15,  7,    14
1,        5/21/2008 12:16,  7,    14

在上表中，缺少 12:06、12:10 和 12:12 的时间戳，而 12:15 不应该存在，因为每个间隔应该是 2 分钟。 我在以下链接尝试了 rbrhodes 提供的以下代码：

https://www.ozgrid.com/forum/forum/help-forums/excel-general/85157-insert-fill-missing-rows-within-sequential-dates-times-list

代码： 显式选项

Sub rowinsert()

Dim ThisTime As Double
Dim NextTime As Double
Dim cel As Range
Dim rng As Range
Dim LastRow As Long
Dim rval As Variant

'Speed
Application.ScreenUpdating = False

'Get last row of data
LastRow = Range("B" & Rows.Count).End(xlUp).Row

'Where to look
Set rng = Range("B1:B" & LastRow)

'Chek all
For Each cel In rng
'Check if done
If cel.Offset(1, 0) = vbNullString Then GoTo endo
'Add 15 mins to cell value
ThisTime = Round((cel + TimeValue("00:02:00")) * 24 * 30) / 30 / 24
'Get next cel time
NextTime = Round(cel.Offset(1, 0) * 24 * 30) / 30 / 24
'Check if time is + 2
If ThisTime <> NextTime Then
'No. Insert a row
cel.Offset(1, 0).EntireRow.Insert shift:=xlDown
'Put next req'd time
cel.Offset(1, 0) = ThisTime
'Put 'N/A'
Range(cel.Offset(1, 1), cel.Offset(1, 2)) = "N/A"
End If
Next

endo:

'Cleanup
Set cel = Nothing
Set rng = Nothing

'Reset
Application.ScreenUpdating = True

End Sub

对于缺失值，它工作得非常好。但如果有 12:14、12:15、12:16 等顺序的时间戳，则该代码不起作用。

我需要修改代码以删除包含“奇数”时间戳的行。 这是我第一次使用 VBA。任何帮助将不胜感激。 谢谢。

Answer 1

你有这条线正在为缺失值工作

If ThisTime <> NextTime Then 
   cel.Offset(1, 0).EntireRow.Insert shift:=xlDown

但是没有一行可以删除您不想要的那些。喜欢

If NextTime < 00:02 Then    '<<---I'm not sure if the time format is correct
   cel.Offset(1, 0).EntireRow.Delete shift:=xlUp

或者你可能不得不使用

If NextTime - ThisTime < 00:02 Then
   cel.Offset(1, 0).EntireRow.Delete shift:=xlUp

当您添加看起来像 2 分钟的内容时，我不明白“添加 15 分钟”的评论。希望这会有所帮助