根据间隔值提取时隙

问题描述

在单元格 A1 中,我有一个间隔值,它是一个整数,可以是 1、5 或 15,表示 1 分钟、5 分钟或 15 分钟

在“B1:B12”范围内,我有样本数据(会更多)

12:03
12:03
12:06
12:06
12:09
12:11
12:14
12:15
12:15
12:16
12:31
12:32

现在在 C 列中,我需要根据单元格 A1 中可用的数量提取时隙。

如果单元格 A1 有 15,那么 C 列将包含在下面

12:15
12:30

因为列中的第一个第 15 分钟从 12:15 开始,然后将其增加 15 分钟,直到最后一个可用数据落入该 15 分钟范围内。

如果单元格 A1 有 5,那么 C 列将包含在下面

12:05
12:10
12:15
12:30

因为第一个第 5 分钟从 12:05 开始,然后将其增加 5 分钟,直到最后一个可用数据落在该 15 分钟范围内。

如果单元格 A1 有 1,则提取除重复项外的所有内容

我希望我已经正确解释了这个场景。我无法想出在 excel vba 中执行此操作的逻辑,并且需要有关如何开始的帮助,以便我可以尝试应用逻辑并提出代码

谢谢

编辑

我正在添加所需结果的图片。 如果 A1 包含 1,则复制 C 列中的所有时间戳,不带重复项

如果 A1 包含 5 则只显示 5 次 5 分钟间隔

如果 A1 包含 15 则只显示 15 分钟间隔的 3 次

enter image description here

解决方法

这在 C1 中用作单个单元格公式:

=UNIQUE(INT(B1:B12/(A1/60/24))*(A1/60/24))

enter image description here

分解:

A1/60/24

是您想要的时间间隔(A1 以分钟为单位,因此除以每小时 60 分钟和每天 24 小时以获得 Excel 时间间隔单位)。然后:

INT(B1:B12/(A1/60/24))

将您向下舍入到时间段的开始。然后:

*(A1/60/24)

将您转换回输入时间所在的间隔时间。然后:

UNIQUE(

提取唯一值。

这里的有用之处在于,通过将 B1:B12 作为一个范围,它可以使所有内容(有帮助地)溢出

,

使用 VBA (1) 返回一个数组

您需要ctrl-shif-enter

Option Explicit

Function get_unique_time_interval(ByVal interval_size As Double,ByVal input_data As Range) As Variant

  interval_size = interval_size / 60# / 24#
  
  Dim d
  Set d = CreateObject("Scripting.Dictionary")
  
  Dim r As Range
  For Each r In input_data
    Dim t As Double
    t = Int(r.Value / interval_size) * interval_size
    If Not d.exists(t) Then d.Add t,t
  Next r
  
  get_unique_time_interval = Application.WorksheetFunction.Transpose(d.keys)

End Function

(2) 硬编码输出到 C1

option explicit
Sub get_unique_time_interval_sub()

  Dim interval_size As Double: interval_size = ActiveSheet.Range("a1").Value
  Dim input_data As Range: Set input_data = Range(ThisWorkbook.Sheets(1).Range("b1"),ThisWorkbook.Sheets(1).Range("b1").End(xlDown))
  
  interval_size = interval_size / 60# / 24#
  
  Dim d
  Set d = CreateObject("Scripting.Dictionary")
  
  Dim r As Range
  For Each r In input_data
    Dim t As Double
    t = Int(r.Value / interval_size) * interval_size
    If Not d.exists(t) Then d.Add t,t
  Next r
  
  Dim v As Variant
  Dim i As Long
  i = 0
  If Not IsEmpty(Range("c1").Value) Then Range(Range("c1"),Range("c1").End(xlDown)).ClearContents
  For Each v In d.keys
    ThisWorkbook.Sheets(1).Range("c1").Offset(i,0).Value = v
    i = i + 1
  Next v

End Sub
,

如果您接受基于公式的答案,那么这应该适合您:

A1:一些间隔值。

B1:

=0.5+A1/(24*60)

其中 0.5 在 Excel 中表示 12:00。

在 B2 中:

=B1+$A$1/(24*60)

然后将这个公式拖到您需要的地方。

示例:

enter image description here enter image description here