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

我不明白＆＃34;增加15分钟＆＃34;在添加看似2分钟的内容时发表评论。希望这有帮助

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

1 个答案: